diff gcc/testsuite/ada/acats/tests/cc/cc3016c.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,192 @@
+-- CC3016C.ADA
+
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+--     unlimited rights in the software and documentation contained herein.
+--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+--     this public release, the Government intends to confer upon all 
+--     recipients unlimited rights  equal to those held by the Government.  
+--     These rights include rights to use, duplicate, release or disclose the 
+--     released technical data and computer software in whole or in part, in 
+--     any manner and for any purpose whatsoever, and to have or permit others 
+--     to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--  CHECK THAT AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
+--  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
+--  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
+--  DECLARATIONS (IN SPEC AND IN BODY).
+
+-- HISTORY:
+--         EDWARD V. BERARD, 8 AUGUST 1990
+
+WITH REPORT;
+
+PROCEDURE  CC3016C  IS
+
+    GENERIC
+    
+        TYPE SOME_TYPE IS PRIVATE ;
+        FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
+        SECOND_INITIAL_VALUE : IN SOME_TYPE ;
+        WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                               RESULT : OUT SOME_TYPE) ;
+        WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                      RESULT : OUT SOME_TYPE) ;
+        WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
+                                     RESULT : OUT SOME_TYPE) ;
+        FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+        SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+        THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+        FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+        FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+        SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+    
+    PACKAGE OUTER IS
+
+        VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+        
+        FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
+
+        GENERIC
+        
+            INITIAL_VALUE : IN SOME_TYPE ;
+            WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                                   RESULT : OUT SOME_TYPE) ;
+            WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                          RESULT : OUT SOME_TYPE) ;
+            FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+            SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+            THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+            FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+                    
+        PACKAGE INNER  IS
+            VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+        END INNER ;
+        
+    END OUTER ;
+
+
+    PACKAGE BODY OUTER IS
+
+        ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+        
+        PACKAGE BODY  INNER  IS
+            ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+        BEGIN  -- INNER
+
+            CHANGE (FIRST  => VARIABLE,
+                    RESULT => VARIABLE) ;
+            CHANGE (FIRST  => ANOTHER_VARIABLE,
+                    RESULT => ANOTHER_VARIABLE) ;
+            OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
+                                 RESULT => OUTER.VARIABLE) ;
+            OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
+                          RESULT => OUTER.ANOTHER_VARIABLE) ;
+
+            IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
+               (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
+               (OUTER.VARIABLE 
+                       /= THIRD_EXPECTED_RESULT) OR
+               (OUTER.ANOTHER_VARIABLE 
+                       /= FOURTH_EXPECTED_RESULT) THEN
+                    REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
+            END IF;
+
+        END INNER ;
+
+        PACKAGE NEW_INNER IS NEW INNER 
+            (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
+             CHANGE                 => CHANGE,
+             SECOND_CHANGE          => THIRD_CHANGE,
+             FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
+             SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
+             THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
+             FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
+             
+        FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
+        BEGIN
+            RETURN NEW_INNER.VARIABLE ;            
+        END INNER_VARIABLE ;
+
+    BEGIN  -- OUTER
+    
+        SECOND_CHANGE (FIRST  => VARIABLE,
+                       RESULT => VARIABLE) ;
+        SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
+                       RESULT => ANOTHER_VARIABLE) ;
+                       
+        IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
+           (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
+           (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
+            REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
+        END IF;
+
+    END OUTER ;
+    
+    PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
+                      GIVING_THIS_RESULT  : OUT INTEGER) IS
+    BEGIN -- DOUBLE
+        GIVING_THIS_RESULT := 2 * THIS_VALUE ;
+    END DOUBLE ;
+    
+    PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
+                      GIVING_THIS_RESULT : OUT INTEGER) IS
+    BEGIN -- ADD_20
+        GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
+    END ADD_20 ;
+    
+    PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
+                          GIVING_THIS_RESULT  : OUT INTEGER) IS
+    BEGIN -- TIMES_FIVE
+        GIVING_THIS_RESULT := 5 * THIS_VALUE ;
+    END TIMES_FIVE ;    
+    
+BEGIN -- CC3016C
+
+    REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
+                 "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
+                 "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
+                 "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
+                   
+    LOCAL_BLOCK:
+    
+    DECLARE
+    
+        PACKAGE NEW_OUTER IS NEW OUTER
+            (SOME_TYPE                 => INTEGER,
+            FIRST_INITIAL_VALUE        => 7,
+            SECOND_INITIAL_VALUE       => 11,
+            CHANGE                     => DOUBLE,
+            SECOND_CHANGE              => ADD_20,
+            THIRD_CHANGE               => TIMES_FIVE,
+            FIRST_EXPECTED_RESULT      => 22, 
+            SECOND_EXPECTED_RESULT     => 22,
+            THIRD_EXPECTED_RESULT      => 27,
+            FOURTH_EXPECTED_RESULT     => 14,
+            FIFTH_EXPECTED_RESULT      => 47,
+            SIXTH_EXPECTED_RESULT      => 34) ;
+
+    BEGIN  -- LOCAL_BLOCK    
+    
+        IF (NEW_OUTER.VARIABLE /= 47) OR
+           (NEW_OUTER.INNER_VARIABLE /= 22) THEN
+            REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
+                          "BODY OF MAIN PROGRAM") ;
+        END IF;
+        
+    END LOCAL_BLOCK ;
+
+    REPORT.RESULT;
+
+END CC3016C;