old-autovect-branch/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada

   1 -- CC3602A.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 ENTRIES MAY BE PASSED AS GENERIC SUBPROGRAM
  27 --     PARAMETERS.
  28
  29 -- HISTORY:
  30 --     DAT 9/25/81     CREATED ORIGINAL TEST.
  31 --     LDC 10/6/88     REVISED; CHECKED THAT DEFAULT NAME CAN BE
  32 --                     IDENTIFIED WITH ENTRY.
  33
  34
  35 WITH REPORT; USE REPORT;
  36
  37 PROCEDURE CC3602A IS
  38      COUNTER : INTEGER := 0;
  39 BEGIN
  40      TEST ("CC3602A", "ENTRIES AS GENERIC SUBPROGRAM PARAMETERS");
  41
  42      DECLARE
  43           TASK TSK IS
  44                ENTRY ENT;
  45           END TSK;
  46
  47           GENERIC
  48                WITH PROCEDURE P;
  49           PROCEDURE GP;
  50
  51           GENERIC
  52                WITH PROCEDURE P;
  53           PACKAGE PK IS END PK;
  54
  55
  56           PROCEDURE E1 RENAMES TSK.ENT;
  57
  58           GENERIC
  59                WITH PROCEDURE P IS TSK.ENT;
  60           PROCEDURE GP_DEF1;
  61
  62           GENERIC
  63                WITH PROCEDURE P IS E1;
  64           PROCEDURE GP_DEF2;
  65
  66           GENERIC
  67                WITH PROCEDURE P IS TSK.ENT;
  68           PACKAGE PK_DEF1 IS END PK_DEF1;
  69
  70           GENERIC
  71                WITH PROCEDURE P IS E1;
  72           PACKAGE PK_DEF2 IS END PK_DEF2;
  73
  74           PROCEDURE GP IS
  75           BEGIN
  76                P;
  77           END GP;
  78
  79           PACKAGE BODY PK IS
  80           BEGIN
  81                P;
  82           END PK;
  83
  84
  85           PROCEDURE GP_DEF1 IS
  86           BEGIN
  87                P;
  88           END GP_DEF1;
  89
  90           PROCEDURE GP_DEF2 IS
  91           BEGIN
  92                P;
  93           END GP_DEF2;
  94
  95           PACKAGE BODY PK_DEF1 IS
  96           BEGIN
  97                P;
  98           END PK_DEF1;
  99
 100           PACKAGE BODY PK_DEF2 IS
 101           BEGIN
 102                P;
 103           END PK_DEF2;
 104
 105           TASK BODY TSK IS
 106           BEGIN
 107                LOOP
 108                     SELECT
 109                          ACCEPT ENT DO
 110                               COUNTER := COUNTER + 1;
 111                          END ENT;
 112                     OR
 113                          TERMINATE;
 114                     END SELECT;
 115                END LOOP;
 116           END TSK;
 117
 118      BEGIN
 119           DECLARE
 120                PROCEDURE P1 IS NEW GP (TSK.ENT);
 121                PROCEDURE E RENAMES TSK.ENT;
 122                PROCEDURE P2 IS NEW GP (E);
 123                PACKAGE PK1 IS NEW PK (TSK.ENT);
 124                PACKAGE PK2 IS NEW PK (E);
 125
 126                PROCEDURE P3 IS NEW GP_DEF1;
 127                PROCEDURE P4 IS NEW GP_DEF2;
 128                PACKAGE PK3 IS NEW PK_DEF1;
 129                PACKAGE PK4 IS NEW PK_DEF2;
 130           BEGIN
 131                P1;
 132                P2;
 133                TSK.ENT;
 134                E;
 135                P3;
 136                P4;
 137           END;
 138           TSK.ENT;
 139      END;
 140
 141      IF COUNTER /= 11 THEN
 142           FAILED ("INCORRECT CALL OF ENTRY AS GENERIC PARAMETER");
 143      END IF;
 144
 145      RESULT;
 146 END CC3602A;