--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,397 @@
+-- CC3007B.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 THE NAMES IN A GENERIC INSTANTIATION ARE STATICALLY
+--  IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA-
+--  TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR-
+--  RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND
+--  BODY TEMPLATES.
+--
+--  SEE AI-00365/05-BI-WJ.
+
+-- HISTORY:
+--      EDWARD V. BERARD, 15 AUGUST 1990
+--      DAS   08 OCT 90   CHANGED INSTANTIATIONS TO USE VARIABLES
+--                        M1 AND M2 IN THE FIRST_BLOCK INSTANTIA-
+--                        TION AND TO ASSIGN THIRD_DATE AND
+--                        FOURTH_DATE VALUES BEFORE AND AFTER THE
+--                        SECOND_BLOCK INSTANTIATION.
+
+WITH REPORT;
+
+PROCEDURE CC3007B IS
+
+     INCREMENTED_VALUE : NATURAL := 0;
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC);
+     TYPE DAY_TYPE IS RANGE 1 .. 31;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE;
+          DAY   : DAY_TYPE;
+          YEAR  : YEAR_TYPE;
+     END RECORD;
+
+     TYPE DATE_ACCESS IS ACCESS DATE;
+
+     TODAY           : DATE := (MONTH => AUG,
+                                DAY   => 8,
+                                YEAR  => 1990);
+
+     CHRISTMAS       : DATE := (MONTH => DEC,
+                                DAY   => 25,
+                                YEAR  => 1948);
+
+     WALL_DATE       : DATE := (MONTH => NOV,
+                                DAY   => 9,
+                                YEAR  => 1989);
+
+     BIRTH_DATE     : DATE := (MONTH => OCT,
+                               DAY   => 3,
+                               YEAR  => 1949);
+
+     FIRST_DUE_DATE : DATE := (MONTH => JAN,
+                               DAY   => 23,
+                               YEAR  => 1990);
+
+     LAST_DUE_DATE  : DATE := (MONTH => DEC,
+                               DAY   => 20,
+                               YEAR  => 1990);
+
+     THIS_MONTH    : MONTH_TYPE := AUG;
+
+     STORED_RECORD : DATE := TODAY;
+
+     STORED_INDEX  : MONTH_TYPE := AUG;
+
+     FIRST_DATE   : DATE_ACCESS := NEW DATE'(WALL_DATE);
+     SECOND_DATE  : DATE_ACCESS := FIRST_DATE;
+
+     THIRD_DATE     : DATE_ACCESS := NEW DATE'(BIRTH_DATE);
+     FOURTH_DATE  : DATE_ACCESS := NEW DATE'(CHRISTMAS);
+
+     TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE;
+     REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
+                                  (MAR, 23, 1990), (APR, 23, 1990),
+                                  (MAY, 23, 1990), (JUN, 22, 1990),
+                                  (JUL, 23, 1990), (AUG, 23, 1990),
+                                  (SEP, 24, 1990), (OCT, 23, 1990),
+                                  (NOV, 23, 1990), (DEC, 20, 1990));
+
+     GENERIC
+
+          NATURALLY     : IN NATURAL;
+          FIRST_RECORD  : IN OUT DATE;
+          SECOND_RECORD : IN OUT DATE;
+          TYPE RECORD_POINTER IS ACCESS DATE;
+          POINTER : IN OUT RECORD_POINTER;
+          TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE;
+          THIS_ARRAY           : IN OUT ARRAY_TYPE;
+          FIRST_ARRAY_ELEMENT  : IN OUT DATE;
+          SECOND_ARRAY_ELEMENT : IN OUT DATE;
+          INDEX_ELEMENT        : IN OUT MONTH_TYPE;
+          POINTER_TEST         : IN OUT DATE;
+          ANOTHER_POINTER_TEST : IN OUT DATE;
+
+     PACKAGE TEST_ACTUAL_PARAMETERS IS
+
+          PROCEDURE EVALUATE_FUNCTION;
+          PROCEDURE CHECK_RECORDS;
+          PROCEDURE CHECK_ACCESS;
+          PROCEDURE CHECK_ARRAY;
+          PROCEDURE CHECK_ARRAY_ELEMENTS;
+          PROCEDURE CHECK_SCALAR;
+          PROCEDURE CHECK_POINTERS;
+
+     END TEST_ACTUAL_PARAMETERS;
+
+     PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
+
+          PROCEDURE EVALUATE_FUNCTION IS
+          BEGIN  -- EVALUATE_FUNCTION
+
+               IF (INCREMENTED_VALUE = 0) OR 
+                  (NATURALLY /= INCREMENTED_VALUE) THEN
+                    REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
+                                   "PARAMETER.");
+               END IF;
+
+          END EVALUATE_FUNCTION;
+
+          PROCEDURE CHECK_RECORDS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_RECORDS
+
+               IF STORED_RECORD /= FIRST_RECORD THEN
+                    REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
+               ELSE
+                    STORED_RECORD := SECOND_RECORD;
+                    STORE := FIRST_RECORD;
+                    FIRST_RECORD := SECOND_RECORD;
+                    SECOND_RECORD := STORE;
+               END IF;
+
+          END CHECK_RECORDS;
+
+          PROCEDURE CHECK_ACCESS IS
+          BEGIN  -- CHECK_ACCESS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF POINTER.ALL /= DATE'(WALL_DATE) THEN
+                         REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                        "- 1");
+                    ELSE
+                         POINTER.ALL := DATE'(BIRTH_DATE);
+                    END IF;
+               ELSE
+                    IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN
+                         REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                        "- 2");
+                    ELSE
+                         POINTER.ALL := DATE'(WALL_DATE);
+                    END IF;
+               END IF;
+
+          END CHECK_ACCESS;
+
+          PROCEDURE CHECK_ARRAY IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_ARRAY
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
+                    ELSE
+                         THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
+                         THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
+                    END IF;
+               ELSE
+                    IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
+                    ELSE
+                         THIS_ARRAY (THIS_ARRAY'FIRST) :=
+                                                  FIRST_DUE_DATE;
+                         THIS_ARRAY (THIS_ARRAY'LAST)  := LAST_DUE_DATE;
+                    END IF;
+               END IF;
+
+          END CHECK_ARRAY;
+
+          PROCEDURE CHECK_ARRAY_ELEMENTS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_ARRAY_ELEMENTS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
+                       (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                        "- 1");
+                    ELSE
+                         STORE := FIRST_ARRAY_ELEMENT;
+                         FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                         SECOND_ARRAY_ELEMENT := STORE;
+                    END IF;
+               ELSE
+                    IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
+                       (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                        "- 2");
+                    ELSE
+                         STORE := FIRST_ARRAY_ELEMENT;
+                         FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                         SECOND_ARRAY_ELEMENT := STORE;
+                    END IF;
+               END IF;
+
+          END CHECK_ARRAY_ELEMENTS;
+
+          PROCEDURE CHECK_SCALAR IS
+          BEGIN  -- CHECK_SCALAR
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF INDEX_ELEMENT /= STORED_INDEX THEN
+                         REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
+                    ELSE
+                         INDEX_ELEMENT :=
+                                   MONTH_TYPE'SUCC(INDEX_ELEMENT);
+                         STORED_INDEX := INDEX_ELEMENT;
+                    END IF;
+               ELSE
+                    IF INDEX_ELEMENT /= STORED_INDEX THEN
+                         REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
+                    ELSE
+                         INDEX_ELEMENT :=
+                              MONTH_TYPE'PRED (INDEX_ELEMENT);
+                         STORED_INDEX := INDEX_ELEMENT;
+                    END IF;
+               END IF;
+
+          END CHECK_SCALAR;
+
+          PROCEDURE CHECK_POINTERS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_POINTERS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR
+                       (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948))
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                        "- 1");
+                    ELSE
+                         STORE := POINTER_TEST;
+                         POINTER_TEST := ANOTHER_POINTER_TEST;
+                         ANOTHER_POINTER_TEST := STORE;
+                    END IF;
+               ELSE
+                    IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR
+                       (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949))
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                        "- 2");
+                    ELSE
+                         STORE := POINTER_TEST;
+                         POINTER_TEST := ANOTHER_POINTER_TEST;
+                         ANOTHER_POINTER_TEST := STORE;
+                    END IF;
+               END IF;
+
+          END CHECK_POINTERS;
+
+     END TEST_ACTUAL_PARAMETERS;
+
+     FUNCTION INC RETURN NATURAL IS
+     BEGIN  -- INC
+          INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
+          RETURN INCREMENTED_VALUE;
+     END INC;
+
+BEGIN  -- CC3007B
+
+     REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " &
+                  "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " &
+                  "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" &
+                  ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " &
+                  "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " &
+                  "THE SPECIFICATION AND BODY TEMPLATES.  " &
+                  "SEE AI-00365/05-BI-WJ.");
+
+     FIRST_BLOCK:
+
+     DECLARE
+
+          M1 : MONTH_TYPE := MAY;
+          M2 : MONTH_TYPE := JUN;
+
+          PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+               NEW TEST_ACTUAL_PARAMETERS (
+                    NATURALLY              => INC,
+                    FIRST_RECORD           => TODAY,
+                    SECOND_RECORD          => CHRISTMAS,
+                    RECORD_POINTER         => DATE_ACCESS,
+                    POINTER                => SECOND_DATE,
+                    ARRAY_TYPE             => DUE_DATES,
+                    THIS_ARRAY             => REPORT_DATES,
+                    FIRST_ARRAY_ELEMENT    => REPORT_DATES (M1),
+                    SECOND_ARRAY_ELEMENT   => REPORT_DATES (M2),
+                    INDEX_ELEMENT          => THIS_MONTH,
+                    POINTER_TEST           => THIRD_DATE.ALL,
+                    ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+
+     BEGIN  -- FIRST_BLOCK
+
+          REPORT.COMMENT ("ENTERING FIRST BLOCK");
+          NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+          M1 := SEP;
+          M2 := OCT;
+          -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS
+          -- VALUES OF MAY AND JUN.
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+
+     END FIRST_BLOCK;
+
+     SECOND_BLOCK:
+
+     DECLARE
+
+          SAVE_THIRD_DATE  : DATE_ACCESS := THIRD_DATE;
+          SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
+
+          PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+               NEW TEST_ACTUAL_PARAMETERS (
+                    NATURALLY              => INC,
+                    FIRST_RECORD           => TODAY,
+                    SECOND_RECORD          => CHRISTMAS,
+                    RECORD_POINTER         => DATE_ACCESS,
+                    POINTER                => SECOND_DATE,
+                    ARRAY_TYPE             => DUE_DATES,
+                    THIS_ARRAY             => REPORT_DATES,
+                    FIRST_ARRAY_ELEMENT    => REPORT_DATES (MAY),
+                    SECOND_ARRAY_ELEMENT   => REPORT_DATES (JUN),
+                    INDEX_ELEMENT          => THIS_MONTH,
+                    POINTER_TEST           => THIRD_DATE.ALL,
+                    ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+
+     BEGIN  -- SECOND_BLOCK
+
+          REPORT.COMMENT ("ENTERING SECOND BLOCK");
+          NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+
+          THIRD_DATE := NEW DATE'(JUL, 13, 1951);
+          FOURTH_DATE := NEW DATE'(JUL, 4, 1976);
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+          THIRD_DATE := SAVE_THIRD_DATE;
+          FOURTH_DATE := SAVE_FOURTH_DATE;
+
+     END SECOND_BLOCK;
+
+     REPORT.RESULT;
+
+END CC3007B;