old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c38005b.ada

   1 -- C38005B.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 -- OBJECTIVE:
  26 --     CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE TYPE, WHOSE ACTUAL
  27 --     TYPE IN AN INSTANTIATION IS AN ACCESS TYPE, IS INITIALIZED BY
  28 --     DEFAULT TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH ARE ARRAY
  29 --     AND RECORD COMPONENTS.
  30
  31 -- HISTORY:
  32 --     DHH 07/12/88 CREATED ORIGINAL TEST.
  33
  34 WITH REPORT; USE REPORT;
  35 PROCEDURE C38005B IS
  36
  37 BEGIN
  38      TEST("C38005B", "CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE " &
  39                      "TYPE, WHOSE ACTUAL TYPE IN AN INSTANTIATION " &
  40                      "IS AN ACCESS TYPE, IS INITIALIZED BY DEFAULT " &
  41                      "TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH " &
  42                      "ARE ARRAY AND RECORD COMPONENTS");
  43      DECLARE
  44           TYPE ARRY IS ARRAY(1 .. 10) OF BOOLEAN;
  45           TYPE REC1 IS
  46                RECORD
  47                     A : INTEGER;
  48                     B : ARRY;
  49                END RECORD;
  50
  51           TYPE POINTER IS ACCESS REC1;
  52
  53           GENERIC
  54                TYPE NEW_PTR IS PRIVATE;
  55           PACKAGE GEN_PACK IS
  56                TYPE PTR_ARY IS ARRAY(1 .. 5) OF NEW_PTR;
  57                TYPE RECORD1 IS
  58                     RECORD
  59                          A : NEW_PTR;
  60                          B : PTR_ARY;
  61                     END RECORD;
  62
  63                OBJ : NEW_PTR;
  64                ARY : PTR_ARY;
  65                REC : RECORD1;
  66           END GEN_PACK;
  67
  68           PACKAGE TEST_P IS NEW GEN_PACK(POINTER);
  69           USE TEST_P;
  70
  71      BEGIN
  72           IF OBJ /= NULL THEN
  73                FAILED("OBJECT NOT INITIALIZED TO NULL");
  74           END IF;
  75
  76           FOR I IN 1 .. 5 LOOP
  77                IF ARY(I) /= NULL THEN
  78                     FAILED("ARRAY COMPONENT " &
  79                             INTEGER'IMAGE(I) &
  80                            " NOT INITIALIZED TO NULL");
  81                END IF;
  82           END LOOP;
  83
  84           IF REC.A /= NULL THEN
  85                FAILED("RECORD OBJECT NOT INITIALIZED TO NULL");
  86           END IF;
  87
  88           FOR I IN 1 .. 5 LOOP
  89                IF REC.B(I) /= NULL THEN
  90                     FAILED("RECORD SUBCOMPONENT " &
  91                            INTEGER'IMAGE(I) &
  92                            " NOT INITIALIZED TO NULL");
  93                END IF;
  94           END LOOP;
  95      END;
  96
  97      RESULT;
  98 END C38005B;