gcc/testsuite/ada/acats/tests/c4/c45291a.ada

   1 -- C45291A.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 THE MEMBERSHIP TESTS YIELD CORRECT RESULTS FOR TASK
  27 --     TYPES, LIMITED PRIVATE TYPES, COMPOSITE LIMITED TYPES, AND
  28 --     PRIVATE TYPES WITHOUT DISCRIMINANTS.
  29
  30 -- HISTORY:
  31 --     JET 08/10/88  CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C45291A IS
  35
  36      TASK TYPE TASK1 IS
  37           ENTRY E;
  38      END TASK1;
  39
  40      PACKAGE PACK IS
  41           TYPE LIM_PRIV IS LIMITED PRIVATE;
  42           TYPE LIM_COMP IS ARRAY (1..10) OF LIM_PRIV;
  43           TYPE PRIV IS PRIVATE;
  44           PROCEDURE INIT(LP : OUT LIM_PRIV;
  45                          LC : IN OUT LIM_COMP;
  46                          P  : OUT PRIV);
  47      PRIVATE
  48           TYPE LIM_PRIV IS RANGE -100..100;
  49           TYPE PRIV IS RECORD
  50                I : INTEGER;
  51           END RECORD;
  52      END PACK;
  53
  54      SUBTYPE SUB_TASK1 IS TASK1;
  55      SUBTYPE SUB_LIM_PRIV IS PACK.LIM_PRIV;
  56      SUBTYPE SUB_LIM_COMP IS PACK.LIM_COMP;
  57      SUBTYPE SUB_PRIV IS PACK.PRIV;
  58
  59      T1 : TASK1;
  60      LP : PACK.LIM_PRIV;
  61      LC : PACK.LIM_COMP;
  62      P  : PACK.PRIV;
  63
  64      TASK BODY TASK1 IS
  65      BEGIN
  66           ACCEPT E DO
  67                NULL;
  68           END E;
  69      END TASK1;
  70
  71      PACKAGE BODY PACK IS
  72           PROCEDURE INIT (LP : OUT LIM_PRIV;
  73                           LC : IN OUT LIM_COMP;
  74                           P  : OUT PRIV) IS
  75           BEGIN
  76                LP := 0;
  77                LC := (OTHERS => 0);
  78                P  := (I => 0);
  79           END INIT;
  80      END PACK;
  81
  82 BEGIN
  83      TEST ("C45291A", "CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT " &
  84                       "RESULTS FOR TASK TYPES, LIMITED PRIVATE TYPES," &
  85                       " COMPOSITE LIMITED TYPES, AND PRIVATE TYPES " &
  86                       "WITHOUT DISCRIMINANTS");
  87
  88      PACK.INIT(LP, LC, P);
  89
  90      IF NOT IDENT_BOOL(T1 IN TASK1) THEN
  91           FAILED ("INCORRECT VALUE OF 'T1 IN TASK1'");
  92      END IF;
  93
  94      IF IDENT_BOOL(T1 NOT IN TASK1) THEN
  95           FAILED ("INCORRECT VALUE OF 'T1 NOT IN TASK1'");
  96      END IF;
  97
  98      IF NOT IDENT_BOOL(LP IN PACK.LIM_PRIV) THEN
  99           FAILED ("INCORRECT VALUE OF 'LP IN LIM_PRIV'");
 100      END IF;
 101
 102      IF IDENT_BOOL(LP NOT IN PACK.LIM_PRIV) THEN
 103           FAILED ("INCORRECT VALUE OF 'LP NOT IN LIM_PRIV'");
 104      END IF;
 105
 106      IF NOT IDENT_BOOL(LC IN PACK.LIM_COMP) THEN
 107           FAILED ("INCORRECT VALUE OF 'LC IN LIM_COMP'");
 108      END IF;
 109
 110      IF IDENT_BOOL(LC NOT IN PACK.LIM_COMP) THEN
 111           FAILED ("INCORRECT VALUE OF 'LC NOT IN LIM_COMP'");
 112      END IF;
 113
 114      IF NOT IDENT_BOOL(P IN PACK.PRIV) THEN
 115           FAILED ("INCORRECT VALUE OF 'P IN PRIV'");
 116      END IF;
 117
 118      IF IDENT_BOOL(P NOT IN PACK.PRIV) THEN
 119           FAILED ("INCORRECT VALUE OF 'P NOT IN PRIV'");
 120      END IF;
 121
 122      IF NOT IDENT_BOOL(T1 IN SUB_TASK1) THEN
 123           FAILED ("INCORRECT VALUE OF 'T1 IN SUB_TASK1'");
 124      END IF;
 125
 126      IF IDENT_BOOL(T1 NOT IN SUB_TASK1) THEN
 127           FAILED ("INCORRECT VALUE OF 'T1 NOT IN SUB_TASK1'");
 128      END IF;
 129
 130      IF NOT IDENT_BOOL(LP IN SUB_LIM_PRIV) THEN
 131           FAILED ("INCORRECT VALUE OF 'LP IN SUB_LIM_PRIV'");
 132      END IF;
 133
 134      IF IDENT_BOOL(LP NOT IN SUB_LIM_PRIV) THEN
 135           FAILED ("INCORRECT VALUE OF 'LP NOT IN SUB_LIM_PRIV'");
 136      END IF;
 137
 138      IF NOT IDENT_BOOL(LC IN SUB_LIM_COMP) THEN
 139           FAILED ("INCORRECT VALUE OF 'LC IN SUB_LIM_COMP'");
 140      END IF;
 141
 142      IF IDENT_BOOL(LC NOT IN SUB_LIM_COMP) THEN
 143           FAILED ("INCORRECT VALUE OF 'LC NOT IN SUB_LIM_COMP'");
 144      END IF;
 145
 146      IF NOT IDENT_BOOL(P IN SUB_PRIV) THEN
 147           FAILED ("INCORRECT VALUE OF 'P IN SUB_PRIV'");
 148      END IF;
 149
 150      IF IDENT_BOOL(P NOT IN SUB_PRIV) THEN
 151           FAILED ("INCORRECT VALUE OF 'P NOT IN SUB_PRIV'");
 152      END IF;
 153
 154      T1.E;
 155
 156      RESULT;
 157
 158 END C45291A;