toolchain/gcc/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada

   1 -- C87B39A.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:
  26
  27 --   A) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
  28 --      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
  29 --      THE ALLOCATOR.
  30 --
  31 --   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
  32 --      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
  33 --      MUST DETERMINE THE TYPE.
  34
  35 -- JBG 1/30/84
  36
  37 WITH REPORT; USE REPORT;
  38 PROCEDURE C87B39A IS
  39
  40      TYPE S IS (M, F);
  41      TYPE R (D : S) IS
  42           RECORD NULL; END RECORD;
  43      SUBTYPE M1 IS R(M);
  44      SUBTYPE M2 IS R(M);
  45
  46      TYPE ACC_M1 IS ACCESS M1;
  47      TYPE ACC_M2 IS ACCESS M2;
  48      TYPE ACC_BOOL IS ACCESS BOOLEAN;
  49      TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
  50
  51      TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
  52
  53      PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
  54      BEGIN
  55           IF RESOLUTION /= IS_M1 THEN
  56                FAILED ("INCORRECT RESOLUTION -- ACC_M1");
  57           END IF;
  58      END P;    -- ACC_M1
  59
  60      PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
  61      BEGIN
  62           IF RESOLUTION /= IS_M2 THEN
  63                FAILED ("INCORRECT RESOLUTION -- ACC_M2");
  64           END IF;
  65      END P;    -- ACC_M2
  66
  67      PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
  68      BEGIN
  69           IF RESOLUTION /= IS_BOOL THEN
  70                FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
  71           END IF;
  72      END P;    -- ACC_BOOL
  73
  74      PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
  75      BEGIN
  76           FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
  77      END P;    -- ACC_ACC_M1
  78
  79      PROCEDURE Q (X : ACC_M1) IS
  80      BEGIN
  81           NULL;
  82      END Q;    -- ACC_M1
  83
  84      PROCEDURE Q (X : ACC_BOOL) IS
  85      BEGIN
  86           FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
  87      END Q;    -- ACC_BOOL
  88
  89 BEGIN
  90
  91      TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
  92
  93      P (ACC_M1'(NEW R(M)), IS_M1);    -- B
  94
  95      P (ACC_M2'(NEW M1), IS_M2);      -- B
  96
  97      P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
  98
  99      Q (NEW M2);              -- A
 100      Q (NEW M1);              -- A
 101      Q (NEW R(M));            -- A
 102      Q (NEW R'(D => M));      -- A
 103
 104      RESULT;
 105
 106 END C87B39A;