gcc/testsuite/ada/acats/tests/c3/c38005a.ada

   1 -- C38005A.ADA
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 -- CHECK THAT ALL (UNINITIALIZED) ACCESS OBJECTS ARE INITIALIZED
  26 -- TO NULL BY DEFAULT. VARIABLES, ARRAYS, RECORDS, ARRAYS OF RECORDS,
  27 -- ARRAYS OF ARRAYS, RECORDS WITH ARRAYS AND RECORD COMPONENTS
  28 -- ARE ALL CHECKED.
  29 -- FUNCTION RESULTS (I.E. RETURNED FROM IMPLICIT FUNCTION RETURN)
  30 -- ARE NOT CHECKED.
  31
  32 -- DAT 3/6/81
  33 -- VKG 1/5/83
  34 -- SPS 2/17/83
  35
  36 WITH REPORT; USE REPORT;
  37
  38 PROCEDURE C38005A IS
  39
  40      TYPE REC;
  41      TYPE ACC_REC IS ACCESS REC;
  42      TYPE VECTOR IS ARRAY ( NATURAL RANGE <> ) OF ACC_REC;
  43      TYPE REC IS RECORD
  44           VECT : VECTOR (3 .. 5);
  45      END RECORD;
  46
  47      TYPE ACC_VECT IS ACCESS VECTOR;
  48      TYPE ARR_REC IS ARRAY (1 .. 2) OF REC;
  49      TYPE REC2;
  50      TYPE ACC_REC2 IS ACCESS REC2;
  51      TYPE REC2 IS RECORD
  52           C1 : ACC_REC;
  53           C2 : ACC_VECT;
  54           C3 : ARR_REC;
  55           C4 : REC;
  56           C5 : ACC_REC2;
  57      END RECORD;
  58
  59      N_REC      : REC;
  60      N_ACC_REC  : ACC_REC;
  61      N_VEC      : VECTOR (3 .. IDENT_INT (5));
  62      N_ACC_VECT : ACC_VECT;
  63      N_ARR_REC  : ARR_REC;
  64      N_REC2     : REC2;
  65      N_ACC_REC2 : ACC_REC2;
  66      N_ARR      : ARRAY (1..2) OF VECTOR (1..2);
  67      Q : REC2 :=
  68                 (C1 => NEW REC,
  69                  C2 => NEW VECTOR'(NEW REC, NEW REC'(N_REC)),
  70                  C3 => (1 | 2 => (VECT=>(3|4=> NEW REC,
  71                                          5=>N_ACC_REC)
  72                                  )),
  73                  C4 => N_REC2.C4,
  74                  C5 => NEW REC2'(N_REC2));
  75
  76 BEGIN
  77      TEST ("C38005A", "DEFAULT VALUE FOR ACCESS OBJECTS IS NULL");
  78
  79      IF N_REC /= REC'(VECT => (3..5 => NULL))
  80      THEN
  81           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 1");
  82      END IF;
  83
  84      IF N_ACC_REC /= NULL
  85      THEN
  86           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 2");
  87      END IF;
  88
  89      IF N_VEC /= N_REC.VECT
  90      THEN
  91           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 3");
  92      END IF;
  93
  94      IF N_ARR /= ((NULL, NULL), (NULL, NULL))
  95      THEN
  96           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 4");
  97      END IF;
  98
  99      IF N_ACC_VECT /= NULL
 100      THEN
 101           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 5");
 102      END IF;
 103
 104      IF N_ARR_REC /= (N_REC, N_REC)
 105      THEN
 106           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 6");
 107      END IF;
 108
 109      IF N_REC2 /= (NULL, NULL, N_ARR_REC, N_REC, NULL)
 110      THEN
 111           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 7");
 112      END IF;
 113
 114      IF N_ACC_REC2 /= NULL
 115      THEN
 116           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 8");
 117      END IF;
 118
 119      IF Q /= (Q.C1, Q.C2, (Q.C3(1), Q.C3(2)), N_REC, Q.C5)
 120      THEN
 121           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 9");
 122      END IF;
 123
 124      IF Q.C1.ALL /= N_REC
 125      THEN
 126           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 10");
 127      END IF;
 128
 129      IF Q.C2.ALL(0).ALL /= N_REC
 130      THEN
 131           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 11");
 132      END IF;
 133
 134      IF Q.C2(1).VECT /= N_VEC
 135      THEN
 136           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 12");
 137      END IF;
 138
 139      IF Q.C3(2).VECT /= (3 => Q.C3(2).VECT(3),
 140                          4 => Q.C3(2).VECT(4),
 141                          5=>NULL)
 142      THEN
 143           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 13");
 144      END IF;
 145
 146      IF Q.C3(2).VECT(3).ALL /= N_REC
 147      THEN
 148           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 14");
 149      END IF;
 150
 151      IF Q.C5.ALL /= N_REC2
 152      THEN
 153           FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 15");
 154      END IF;
 155
 156      DECLARE
 157           PROCEDURE T (R : OUT REC2) IS
 158           BEGIN
 159                NULL;
 160           END T;
 161      BEGIN
 162           N_REC2 := Q;
 163           T(Q);
 164           IF Q /= N_REC2 THEN
 165                FAILED ("INCORRECT OUT PARM INIT 2");
 166           END IF;
 167      END;
 168
 169      RESULT;
 170 END C38005A;