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/] [c45282a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C45282A.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 IN AND NOT IN ARE EVALUATED CORRECTLY FOR : -- A) ACCESS TO SCALAR TYPES; -- B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED); -- C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT -- DISCRIMINANTS; -- TBN 8/8/86 WITH REPORT; USE REPORT; PROCEDURE C45282A IS PACKAGE P IS TYPE KEY IS PRIVATE; FUNCTION INIT_KEY (X : NATURAL) RETURN KEY; TYPE NEWKEY IS LIMITED PRIVATE; TYPE ACC_NKEY IS ACCESS NEWKEY; PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY); PRIVATE TYPE KEY IS NEW NATURAL; TYPE NEWKEY IS NEW KEY; END P; USE P; SUBTYPE I IS INTEGER; TYPE ACC_INT IS ACCESS I; P_INT : ACC_INT; SUBTYPE INT IS INTEGER RANGE 1 .. 5; TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER; TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1; SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2); SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3); ARA1 : ACC_ARA_1; ARA2 : ACC_ARA_2; ARA3 : ACC_ARA_3; TYPE GREET IS RECORD NAME : STRING (1 .. 2); END RECORD; TYPE ACC_GREET IS ACCESS GREET; INTRO : ACC_GREET; TYPE ACC_KEY IS ACCESS KEY; KEY1 : ACC_KEY; KEY2 : ACC_NKEY; PACKAGE BODY P IS FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS BEGIN RETURN (KEY(X)); END INIT_KEY; PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS BEGIN Y.ALL := NEWKEY (1); END ASSIGN_NEWKEY; END P; BEGIN TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " & "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " & "RECORD TYPES, PRIVATE TYPES, AND LIMITED " & "PRIVATE TYPES WITHOUT DISCRIMINANTS"); -- CASE A IF P_INT NOT IN ACC_INT THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1"); END IF; P_INT := NEW INT'(5); IF P_INT IN ACC_INT THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2"); END IF; -- CASE B IF ARA1 NOT IN ACC_ARA_1 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3"); END IF; IF ARA1 NOT IN ACC_ARA_2 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4"); END IF; IF ARA1 IN ACC_ARA_3 THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5"); END IF; IF ARA2 IN ACC_ARA_1 THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6"); END IF; IF ARA3 NOT IN ACC_ARA_1 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7"); END IF; ARA1 := NEW ARRAY_TYPE1'(1, 2, 3); IF ARA1 IN ACC_ARA_1 THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8"); END IF; IF ARA1 IN ACC_ARA_2 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9"); END IF; IF ARA1 NOT IN ACC_ARA_3 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10"); END IF; ARA2 := NEW ARRAY_TYPE1'(1, 2); IF ARA2 NOT IN ACC_ARA_1 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11"); END IF; IF ARA2 NOT IN ACC_ARA_2 THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12"); END IF; -- CASE C IF INTRO NOT IN ACC_GREET THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13"); END IF; INTRO := NEW GREET'(NAME => "HI"); IF INTRO IN ACC_GREET THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14"); END IF; IF KEY1 NOT IN ACC_KEY THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15"); END IF; KEY1 := NEW KEY'(INIT_KEY (1)); IF KEY1 IN ACC_KEY THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16"); END IF; IF KEY2 NOT IN ACC_NKEY THEN FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17"); END IF; KEY2 := NEW NEWKEY; ASSIGN_NEWKEY (KEY2); IF KEY2 IN ACC_NKEY THEN NULL; ELSE FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18"); END IF; RESULT; END C45282A;