old-autovect-branch/gcc/testsuite/ada/acats/tests/c9/c94011a.ada

   1 -- C94011A.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 IF A FORMAL ACCESS TYPE OF A GENERIC UNIT DESIGNATES A
  26 -- FORMAL LIMITED PRIVATE TYPE, THEN WHEN THE UNIT IS INSTANTIATED WITH
  27 -- A TASK TYPE OR A TYPE HAVING A SUBCOMPONENT OF A TASK TYPE, THE
  28 -- MASTER FOR ANY TASKS ALLOCATED WITHIN THE INSTANTIATED UNIT IS
  29 -- DETERMINED BY THE ACTUAL PARAMETER.
  30
  31 -- TBN  9/22/86
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C94011A IS
  35
  36      GLOBAL_INT : INTEGER := 0;
  37      MY_EXCEPTION : EXCEPTION;
  38
  39      PACKAGE P IS
  40           TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
  41           PROCEDURE E (T : LIM_PRI_TASK);
  42      PRIVATE
  43           TASK TYPE LIM_PRI_TASK IS
  44                ENTRY E;
  45           END LIM_PRI_TASK;
  46      END P;
  47
  48      USE P;
  49
  50      TASK TYPE TT IS
  51           ENTRY E;
  52      END TT;
  53
  54      TYPE REC IS
  55           RECORD
  56                A : INTEGER := 1;
  57                B : TT;
  58           END RECORD;
  59
  60      TYPE LIM_REC IS
  61           RECORD
  62                A : INTEGER := 1;
  63                B : LIM_PRI_TASK;
  64           END RECORD;
  65
  66      PACKAGE BODY P IS
  67           TASK BODY LIM_PRI_TASK IS
  68           BEGIN
  69                ACCEPT E;
  70                GLOBAL_INT := IDENT_INT (2);
  71           END LIM_PRI_TASK;
  72
  73           PROCEDURE E (T : LIM_PRI_TASK) IS
  74           BEGIN
  75                T.E;
  76           END E;
  77      END P;
  78
  79      TASK BODY TT IS
  80      BEGIN
  81           ACCEPT E;
  82           GLOBAL_INT := IDENT_INT (1);
  83      END TT;
  84
  85      GENERIC
  86           TYPE T IS LIMITED PRIVATE;
  87           TYPE ACC_T IS ACCESS T;
  88      PROCEDURE PROC (A : OUT ACC_T);
  89
  90      PROCEDURE PROC (A : OUT ACC_T) IS
  91      BEGIN
  92           A := NEW T;
  93      END PROC;
  94
  95      GENERIC
  96           TYPE T IS LIMITED PRIVATE;
  97           TYPE ACC_T IS ACCESS T;
  98      FUNCTION FUNC RETURN ACC_T;
  99
 100      FUNCTION FUNC RETURN ACC_T IS
 101      BEGIN
 102           RETURN NEW T;
 103      END FUNC;
 104
 105      GENERIC
 106           TYPE T IS LIMITED PRIVATE;
 107           TYPE ACC_T IS ACCESS T;
 108      PACKAGE PAC IS
 109           PTR_T : ACC_T := NEW T;
 110      END PAC;
 111
 112 BEGIN
 113      TEST ("C94011A", "CHECK THAT IF A FORMAL ACCESS TYPE OF A " &
 114                       "GENERIC UNIT DESIGNATES A FORMAL LIMITED " &
 115                       "PRIVATE TYPE, THEN WHEN THE UNIT IS " &
 116                       "INSTANTIATED, THE MASTER FOR ANY TASKS " &
 117                       "ALLOCATED WITHIN THE INSTANTIATED UNIT IS " &
 118                       "DETERMINED BY THE ACTUAL PARAMETER");
 119
 120      -------------------------------------------------------------------
 121      DECLARE
 122           TYPE ACC_TT IS ACCESS TT;
 123           ACC1 : ACC_TT;
 124           PROCEDURE PROC1 IS NEW PROC (TT, ACC_TT);
 125      BEGIN
 126           PROC1 (ACC1);
 127           ACC1.E;
 128      EXCEPTION
 129           WHEN OTHERS =>
 130                FAILED ("TASK DEPENDENT ON WRONG MASTER - 1");
 131      END;
 132      IF GLOBAL_INT = IDENT_INT (0) THEN
 133           FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
 134      END IF;
 135
 136      -------------------------------------------------------------------
 137      BEGIN
 138           GLOBAL_INT := IDENT_INT (0);
 139           DECLARE
 140                TYPE ACC_REC IS ACCESS REC;
 141                A : ACC_REC;
 142                FUNCTION FUNC1 IS NEW FUNC (REC, ACC_REC);
 143           BEGIN
 144                A := FUNC1;
 145                A.B.E;
 146                RAISE MY_EXCEPTION;
 147           EXCEPTION
 148                WHEN MY_EXCEPTION =>
 149                     RAISE MY_EXCEPTION;
 150                WHEN OTHERS =>
 151                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 2");
 152           END;
 153           FAILED ("MY_EXCEPTION NOT RAISED - 2");
 154      EXCEPTION
 155           WHEN MY_EXCEPTION =>
 156                IF GLOBAL_INT = IDENT_INT (0) THEN
 157                     FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
 158                END IF;
 159           WHEN OTHERS =>
 160                FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
 161      END;
 162
 163      -------------------------------------------------------------------
 164      GLOBAL_INT := IDENT_INT (0);
 165
 166      BEGIN
 167           DECLARE
 168                TYPE ACC_LIM_TT IS ACCESS LIM_PRI_TASK;
 169           BEGIN
 170                DECLARE
 171                     A : ACC_LIM_TT;
 172                     FUNCTION FUNC2 IS NEW FUNC (LIM_PRI_TASK,
 173                                                             ACC_LIM_TT);
 174                BEGIN
 175                     A := FUNC2;
 176                     E (A.ALL);
 177                END;
 178           EXCEPTION
 179                WHEN OTHERS =>
 180                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 3");
 181           END;
 182           IF GLOBAL_INT = IDENT_INT (0) THEN
 183                FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
 184           END IF;
 185      END;
 186
 187      -------------------------------------------------------------------
 188      GLOBAL_INT := IDENT_INT (0);
 189
 190      BEGIN
 191           DECLARE
 192                TYPE ACC_LIM_REC IS ACCESS LIM_REC;
 193           BEGIN
 194                DECLARE
 195                     ACC2 : ACC_LIM_REC;
 196                     PROCEDURE PROC2 IS NEW PROC (LIM_REC, ACC_LIM_REC);
 197                BEGIN
 198                     PROC2 (ACC2);
 199                     E (ACC2.B);
 200                END;
 201                RAISE MY_EXCEPTION;
 202           EXCEPTION
 203                WHEN MY_EXCEPTION =>
 204                     RAISE MY_EXCEPTION;
 205                WHEN OTHERS =>
 206                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 4");
 207           END;
 208           FAILED ("MY_EXCEPTION NOT RAISED - 4");
 209      EXCEPTION
 210           WHEN MY_EXCEPTION =>
 211                IF GLOBAL_INT = IDENT_INT (0) THEN
 212                     FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
 213                END IF;
 214           WHEN OTHERS =>
 215                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
 216      END;
 217
 218      -------------------------------------------------------------------
 219      BEGIN
 220            GLOBAL_INT := IDENT_INT (0);
 221
 222           DECLARE
 223                TYPE ACC_TT IS ACCESS TT;
 224                PACKAGE PAC1 IS NEW PAC (TT, ACC_TT);
 225                USE PAC1;
 226           BEGIN
 227                PTR_T.E;
 228                RAISE MY_EXCEPTION;
 229           EXCEPTION
 230                WHEN MY_EXCEPTION =>
 231                     RAISE MY_EXCEPTION;
 232                WHEN OTHERS =>
 233                     FAILED ("TASK DEPENDENT ON WRONG MASTER - 5");
 234           END;
 235           FAILED ("MY_EXCEPTION NOT RAISED - 5");
 236      EXCEPTION
 237           WHEN MY_EXCEPTION =>
 238                IF GLOBAL_INT = IDENT_INT (0) THEN
 239                     FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
 240                END IF;
 241           WHEN OTHERS =>
 242                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
 243      END;
 244
 245      -------------------------------------------------------------------
 246      GLOBAL_INT := IDENT_INT (0);
 247
 248      DECLARE
 249           TYPE ACC_LIM_REC IS ACCESS LIM_REC;
 250      BEGIN
 251           DECLARE
 252                PACKAGE PAC2 IS NEW PAC (LIM_REC, ACC_LIM_REC);
 253                USE PAC2;
 254           BEGIN
 255                E (PTR_T.B);
 256           END;
 257      EXCEPTION
 258           WHEN OTHERS =>
 259                FAILED ("TASK DEPENDENT ON WRONG MASTER - 6");
 260      END;
 261      IF GLOBAL_INT = IDENT_INT (0) THEN
 262           FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
 263      END IF;
 264
 265      -------------------------------------------------------------------
 266
 267      RESULT;
 268 END C94011A;