diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada | 347 |
1 files changed, 347 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada new file mode 100644 index 000000000..af3a2bf2d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada @@ -0,0 +1,347 @@ +-- C45282B.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 : +-- D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH +-- DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE +-- TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE; +-- E) ACCESS TO TASK TYPES. + +-- TBN 8/8/86 + +WITH REPORT; USE REPORT; +PROCEDURE C45282B IS + + SUBTYPE INT IS INTEGER RANGE 1 .. 5; + + PACKAGE P IS + TYPE PRI_REC1 (D : INT) IS PRIVATE; + TYPE PRI_REC2 (D : INT := 2) IS PRIVATE; + FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1; + FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2; + TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE; + TYPE ACC_LIM1 IS ACCESS LIM_REC1; + SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2); + PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING); + TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE; + TYPE ACC_LIM2 IS ACCESS LIM_REC2; + SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2); + PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING); + PRIVATE + TYPE PRI_REC1 (D : INT) IS + RECORD + STR : STRING (1 .. D); + END RECORD; + TYPE PRI_REC2 (D : INT := 2) IS + RECORD + STR : STRING (1 .. D); + END RECORD; + TYPE LIM_REC1 (D : INT) IS + RECORD + STR : STRING (1 .. D); + END RECORD; + TYPE LIM_REC2 (D : INT := 2) IS + RECORD + STR : STRING (1 .. D); + END RECORD; + END P; + + USE P; + + TYPE DIS_REC1 (D : INT) IS + RECORD + STR : STRING (1 .. D); + END RECORD; + TYPE DIS_REC2 (D : INT := 5) IS + RECORD + STR : STRING (D .. 8); + END RECORD; + + TYPE ACC1_REC1 IS ACCESS DIS_REC1; + SUBTYPE ACC2_REC1 IS ACC1_REC1 (2); + TYPE ACC1_REC2 IS ACCESS DIS_REC2; + SUBTYPE ACC2_REC2 IS ACC1_REC2 (2); + REC1 : ACC1_REC1; + REC2 : ACC2_REC1; + REC3 : ACC1_REC2; + REC4 : ACC2_REC2; + TYPE ACC_PREC1 IS ACCESS PRI_REC1; + SUBTYPE ACC_SREC1 IS ACC_PREC1 (2); + REC5 : ACC_PREC1; + REC6 : ACC_SREC1; + TYPE ACC_PREC2 IS ACCESS PRI_REC2; + SUBTYPE ACC_SREC2 IS ACC_PREC2 (2); + REC7 : ACC_PREC2; + REC8 : ACC_SREC2; + REC9 : ACC_LIM1; + REC10 : ACC_SUB_LIM1; + REC11 : ACC_LIM2; + REC12 : ACC_SUB_LIM2; + + TASK TYPE T IS + ENTRY E (X : INTEGER); + END T; + + TASK BODY T IS + BEGIN + ACCEPT E (X : INTEGER) DO + IF X /= IDENT_INT(1) THEN + FAILED ("INCORRECT VALUE PASSED TO TASK"); + END IF; + END E; + END T; + + PACKAGE BODY P IS + FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS + REC : PRI_REC1 (A); + BEGIN + REC := (A, B); + RETURN (REC); + END INIT_PREC1; + + FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS + REC : PRI_REC2; + BEGIN + REC := (A, B); + RETURN (REC); + END INIT_PREC2; + + PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS + BEGIN + A.ALL := (B, C); + END ASSIGN_LIM1; + + PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS + BEGIN + A.ALL := (B, C); + END ASSIGN_LIM2; + END P; + +BEGIN + + TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " & + "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " & + "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " & + "TASK TYPES"); + +-- CASE D +------------------------------------------------------------------------ + IF REC1 NOT IN ACC1_REC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1"); + END IF; + IF REC1 IN ACC2_REC1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2"); + END IF; + IF REC2 NOT IN ACC1_REC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3"); + END IF; + REC1 := NEW DIS_REC1'(5, "12345"); + IF REC1 IN ACC1_REC1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4"); + END IF; + IF REC1 IN ACC2_REC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5"); + END IF; + REC2 := NEW DIS_REC1'(2, "HI"); + IF REC2 IN ACC1_REC1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6"); + END IF; + +------------------------------------------------------------------------ + + IF REC3 IN ACC1_REC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7"); + END IF; + IF REC3 NOT IN ACC2_REC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8"); + END IF; + IF REC4 IN ACC1_REC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9"); + END IF; + REC3 := NEW DIS_REC2'(5, "5678"); + IF REC3 IN ACC1_REC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10"); + END IF; + IF REC3 IN ACC2_REC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11"); + END IF; + REC4 := NEW DIS_REC2'(2, "2345678"); + IF REC4 IN ACC1_REC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12"); + END IF; + IF REC4 NOT IN ACC2_REC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13"); + END IF; + +------------------------------------------------------------------------ + + IF REC5 NOT IN ACC_PREC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14"); + END IF; + IF REC5 NOT IN ACC_SREC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15"); + END IF; + IF REC6 NOT IN ACC_PREC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16"); + END IF; + REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345")); + IF REC5 IN ACC_PREC1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17"); + END IF; + IF REC5 IN ACC_SREC1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18"); + END IF; + REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI")); + IF REC6 IN ACC_PREC1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19"); + END IF; + +------------------------------------------------------------------------ + + IF REC7 NOT IN ACC_PREC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20"); + END IF; + IF REC7 NOT IN ACC_SREC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21"); + END IF; + IF REC8 NOT IN ACC_PREC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22"); + END IF; + REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345")); + IF REC7 IN ACC_PREC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23"); + END IF; + IF REC7 IN ACC_SREC2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24"); + END IF; + REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI")); + IF REC8 IN ACC_PREC2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25"); + END IF; + +------------------------------------------------------------------------ + + IF REC9 NOT IN ACC_LIM1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26"); + END IF; + IF REC9 NOT IN ACC_SUB_LIM1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27"); + END IF; + IF REC10 NOT IN ACC_LIM1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28"); + END IF; + REC9 := NEW LIM_REC1 (5); + ASSIGN_LIM1 (REC9, 5, "12345"); + IF REC9 IN ACC_LIM1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29"); + END IF; + IF REC9 IN ACC_SUB_LIM1 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30"); + END IF; + REC10 := NEW LIM_REC1 (2); + ASSIGN_LIM1 (REC10, 2, "12"); + IF REC10 IN ACC_LIM1 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31"); + END IF; + +------------------------------------------------------------------------ + + IF REC11 NOT IN ACC_LIM2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32"); + END IF; + IF REC11 NOT IN ACC_SUB_LIM2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33"); + END IF; + IF REC12 NOT IN ACC_LIM2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34"); + END IF; + REC11 := NEW LIM_REC2; + IF REC11 NOT IN ACC_SUB_LIM2 THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35"); + END IF; + ASSIGN_LIM2 (REC11, 2, "12"); + IF REC11 IN ACC_LIM2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36"); + END IF; + IF REC11 IN ACC_SUB_LIM2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37"); + END IF; + REC12 := NEW LIM_REC2; + ASSIGN_LIM2 (REC12, 2, "12"); + IF REC12 IN ACC_LIM2 THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38"); + END IF; + +-- CASE E +------------------------------------------------------------------------ + DECLARE + TYPE ACC_TASK IS ACCESS T; + T1 : ACC_TASK; + BEGIN + IF T1 NOT IN ACC_TASK THEN + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39"); + END IF; + T1 := NEW T; + IF T1 IN ACC_TASK THEN + NULL; + ELSE + FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38"); + END IF; + T1.E (1); + END; + + RESULT; +END C45282B; |