Subversion Repositories openrisc_me

-- 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;