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/] [c4/] [c43206a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C43206A.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 BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED -- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK -- THAT: -- A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF -- THE LOWER BOUND. -- B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE -- INDEX SUBTYPE FOR NULL RANGES. -- C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL -- BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS -- RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE -- INDEX SUBTYPE. -- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X -- *** remove incompatibilities associated with the transition -- 9X -- *** to Ada 9X. -- 9X -- EG 02/02/84 -- JBG 12/6/84 -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST. WITH REPORT; PROCEDURE C43206A IS USE REPORT; BEGIN TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " & "DETERMINED BY THE BOUNDS SPECIFIED BY THE " & "CHOICES"); DECLARE SUBTYPE ST1 IS INTEGER RANGE 10 .. 15; SUBTYPE ST2 IS INTEGER RANGE 1 .. 5; TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER; TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER; BEGIN CASE_A : BEGIN CASE_A1 : DECLARE PROCEDURE PROC1 (A : T1) IS BEGIN IF A'FIRST /= 12 OR A'LAST /= 10 THEN FAILED ("CASE A1 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN PROC1((12 .. 10 => -2)); EXCEPTION WHEN OTHERS => FAILED ("CASE A1 : EXCEPTION RAISED"); END CASE_A1; CASE_A2 : DECLARE PROCEDURE PROC1 (A : STRING) IS BEGIN IF A'FIRST /= 5 OR A'LAST /= 2 THEN FAILED ("CASE A2 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN PROC1 ((5 .. 2 => 'E')); EXCEPTION WHEN OTHERS => FAILED ("CASE A2 : EXCEPTION RAISED"); END CASE_A2; END CASE_A; CASE_B : BEGIN CASE_B1 : DECLARE PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS BEGIN IF A'FIRST /= L OR A'LAST /= U THEN FAILED ("CASE B1 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN BEGIN PROC1 ((5 .. INTEGER'FIRST => -2), 5, INTEGER'FIRST); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ("CASE B1A : CONSTRAINT_ERROR " & "RAISED FOR NULL RANGE"); WHEN OTHERS => FAILED ("CASE B1A : EXCEPTION RAISED"); END; BEGIN PROC1 ((IDENT_INT(6) .. 3 => -2),6,3); EXCEPTION WHEN OTHERS => FAILED ("CASE B1B : EXCEPTION RAISED"); END; END CASE_B1; CASE_B2 : DECLARE PROCEDURE PROC1 (A : STRING) IS BEGIN IF A'FIRST /= 1 OR A'LAST /= INTEGER'FIRST THEN FAILED ("CASE B2 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN PROC1 ((1 .. INTEGER'FIRST => ' ')); EXCEPTION WHEN OTHERS => FAILED ("CASE B2 : EXCEPTION RAISED"); END CASE_B2; END CASE_B; CASE_C : BEGIN CASE_C1 : DECLARE PROCEDURE PROC1 (A : T2) IS BEGIN IF A'FIRST(1) /= 5 OR A'LAST(1) /= 3 OR A'FIRST(2) /= INTEGER'LAST-1 OR A'LAST(2) /= INTEGER'LAST THEN FAILED ("CASE C1 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN PROC1 ((5 .. 3 => (IDENT_INT(INTEGER'LAST-1) .. IDENT_INT(INTEGER'LAST) => -2))); FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED"); EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("CASE C1 : EXCEPTION RAISED"); END CASE_C1; CASE_C2 : DECLARE PROCEDURE PROC1 (A : T2) IS BEGIN IF A'FIRST(1) /= INTEGER'FIRST OR A'LAST(1) /= INTEGER'FIRST+1 OR A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN FAILED ("CASE C2 : INCORRECT BOUNDS"); END IF; END PROC1; BEGIN PROC1 ((IDENT_INT(INTEGER'FIRST) .. IDENT_INT(INTEGER'FIRST+1) => (14 .. IDENT_INT(11) => -2))); FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED"); EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("CASE C2 : EXCEPTION RAISED"); END CASE_C2; END CASE_C; END; RESULT; END C43206A;