URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c32001b.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C32001B.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. --* -- OBJECTIVE: -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE -- EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE -- SUBTYPE INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE -- EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT -- DECLARATIONS. -- HISTORY: -- RJW 07/16/86 CREATED ORIGINAL TEST. -- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. CHANGED -- COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE -- 1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5. WITH REPORT; USE REPORT; PROCEDURE C32001B IS TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0); FUNCTION F (I : INTEGER) RETURN INTEGER IS BEGIN BUMP (I) := BUMP (I) + 1; RETURN BUMP (I); END F; BEGIN TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & "FOR ARRAY TYPES, THE SUBTYPE INDICATION " & "AND THE INITIALIZATION EXPRESSIONS ARE " & "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & "IS DECLARED AND THE SUBTYPE INDICATION IS " & "EVALUATED FIRST. ALSO, CHECK THAT THE " & "EVALUATIONS YIELD THE SAME RESULT AS A " & "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); DECLARE S1, S2 : ARR (1 .. F (1)) := (OTHERS => F (1)); CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2)); PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS BEGIN IF A'LAST /= 1 THEN FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 ); END IF; IF A (1) /= 2 THEN FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 ); END IF; IF B'LAST /= 3 THEN FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 ); END IF; BEGIN IF B (1 .. 3) = (4, 5, 6) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(4, 5, 6)" ); ELSIF B (1 .. 3) = (5, 4, 6) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(5, 4, 6)" ); ELSIF B (1 .. 3) = (4, 6, 5) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(4, 6, 5)" ); ELSIF B (1 .. 3) = (6, 4, 5) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(6, 4, 5)" ); ELSIF B (1 .. 3) = (6, 5, 4) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(6, 5, 4)" ); ELSIF B (1 .. 3) = (5, 6, 4) THEN COMMENT ( STR2 & " WAS INITIALIZED TO " & "(5, 6, 4)" ); ELSE FAILED ( STR2 & " HAS INCORRECT INITIAL " & "VALUE" ); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED - " & STR2 ); WHEN OTHERS => FAILED ( "EXCEPTION RAISED - " & STR2 ); END; END; BEGIN CHECK (S1, S2, "S1", "S2"); CHECK (CS1, CS2, "CS1", "CS2"); END; DECLARE S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) := (OTHERS => (OTHERS => F (3))); CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF ARR (1 .. F (4)) := (OTHERS => (OTHERS => F (4))); BEGIN IF S3'LAST = 1 THEN IF S3 (1)'LAST = 2 THEN COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " & "COMPONENT TYPE ARR (1 .. 2)" ); IF S3 (1)(1 .. 2) = (3, 4) THEN COMMENT ( "S3 HAS INITIAL VALUES " & "3 AND 4 - 1" ); ELSIF S3 (1)(1 .. 2) = (4, 3) THEN COMMENT ( "S3 HAS INITIAL VALUES " & "4 AND 3 - 1" ); ELSE FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" ); END IF; ELSE FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" ); END IF; ELSIF S3'LAST = 2 THEN IF S3 (1)'LAST = 1 THEN COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " & "COMPONENT TYPE ARR (1 .. 1)" ); IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN COMMENT ( "S3 HAS INITIAL VALUES " & "3 AND 4 - 2" ); ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN COMMENT ( "S3 HAS INITIAL VALUES " & "4 AND 3 - 2" ); ELSE FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" ); END IF; ELSE FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" ); END IF; ELSE FAILED ( "S3 HAS INCORRECT BOUNDS" ); END IF; IF S4'LAST = 5 THEN IF S4 (1)'LAST = 6 THEN COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " & "COMPONENT TYPE ARR (1 .. 6)" ); ELSE FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" ); END IF; ELSIF S4'LAST = 6 THEN IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " & "COMPONENT TYPE ARR (1 .. 5)" ); ELSE FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" ); END IF; ELSE FAILED ( "S4 HAS INCORRECT BOUNDS" ); END IF; IF BUMP (3) /= 36 THEN FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & "TIMES TO INITIALIZE S4" ); END IF; IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " & "COMPONENT TYPE ARR (1 .. 2)" ); IF CS3 (1)(1 .. 2) = (3, 4) THEN COMMENT ( "CS3 HAS INITIAL VALUES " & "3 AND 4 - 1" ); ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN COMMENT ( "CS3 HAS INITIAL VALUES " & "4 AND 3 - 1" ); ELSE FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" ); END IF; ELSE FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" ); END IF; ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " & "COMPONENT TYPE ARR (1 .. 1)" ); IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN COMMENT ( "CS3 HAS INITIAL VALUES " & "3 AND 4 - 2" ); ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN COMMENT ( "CS3 HAS INITIAL VALUES " & "4 AND 3 - 2" ); ELSE FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" ); END IF; ELSE FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" ); END IF; ELSE FAILED ( "CS3 HAS INCORRECT BOUNDS" ); END IF; IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " & "COMPONENT TYPE ARR (1 .. 6)" ); ELSE FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" ); END IF; ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " & "COMPONENT TYPE ARR (1 .. 5)" ); ELSE FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" ); END IF; ELSE FAILED ( "CS4 HAS INCORRECT BOUNDS" ); END IF; IF BUMP (4) /= 36 THEN FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & "TIMES TO INITIALIZE CS4" ); END IF; END; RESULT; END C32001B;