old-autovect-branch/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada

   1 -- C87B41A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
  26 --
  27 -- THE NAMED VARIABLE AND THE RIGHT HAND SIDE EXPRESSION
  28 -- IN AN ASSIGNMENT STATEMENT MUST BE OF THE SAME TYPE. THIS TYPE
  29 -- MUST NOT BE A LIMITED TYPE.
  30
  31 -- TRH  15 SEPT 82
  32 -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
  33
  34 WITH REPORT; USE REPORT;
  35
  36 PROCEDURE C87B41A IS
  37
  38      TYPE NOTE IS (A, B, C, D, E, F, G);
  39      TYPE POSITIVE IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
  40      TYPE ACC_CHAR IS ACCESS CHARACTER;
  41      TYPE ACC_DUR  IS ACCESS DURATION;
  42      TYPE ACC_POS  IS ACCESS POSITIVE;
  43      TYPE ACC_INT  IS ACCESS INTEGER;
  44      TYPE ACC_BOOL IS ACCESS BOOLEAN;
  45      TYPE ACC_STR  IS ACCESS STRING;
  46      TYPE ACC_FLT  IS ACCESS FLOAT;
  47      TYPE ACC_NOTE IS ACCESS NOTE;
  48
  49      TYPE NEW_CHAR IS NEW CHARACTER;
  50      TYPE NEW_DUR  IS NEW DURATION;
  51      TYPE NEW_POS  IS NEW POSITIVE;
  52      TYPE NEW_INT  IS NEW INTEGER;
  53      TYPE NEW_BOOL IS NEW BOOLEAN;
  54      TYPE NEW_FLT  IS NEW FLOAT;
  55      TYPE NEW_NOTE IS NEW NOTE RANGE A .. F;
  56      TASK TYPE T;
  57
  58      TASK BODY T IS
  59      BEGIN
  60           NULL;
  61      END T;
  62
  63      FUNCTION G RETURN T IS
  64           T1 : T;
  65      BEGIN
  66           FAILED ("LIMITED TYPES MAY NOT OCCUR IN ASSIGNMENT " &
  67                   "STATEMENTS");
  68           RETURN T1;
  69      END G;
  70
  71      GENERIC
  72           TYPE T IS PRIVATE;
  73           ARG  : IN T;
  74      FUNCTION F1 RETURN T;
  75
  76      FUNCTION F1 RETURN T IS
  77      BEGIN
  78           FAILED ("RESOLUTION INCORRECT - RIGHT HAND SIDE OF " &
  79                   "ASSIGNMENT STATEMENT MUST MATCH TYPE OF VARIABLE");
  80           RETURN ARG;
  81      END F1;
  82
  83      FUNCTION F IS NEW F1 (ACC_CHAR, NEW CHARACTER);
  84      FUNCTION F IS NEW F1 (ACC_DUR,  NEW DURATION);
  85      FUNCTION F IS NEW F1 (ACC_POS,  NEW POSITIVE);
  86      FUNCTION F IS NEW F1 (ACC_INT,  NEW INTEGER);
  87      FUNCTION F IS NEW F1 (ACC_BOOL, NEW BOOLEAN);
  88      FUNCTION F IS NEW F1 (ACC_STR,  NEW STRING(1..2) );
  89      FUNCTION F IS NEW F1 (ACC_FLT,  NEW FLOAT);
  90
  91      FUNCTION F RETURN ACC_NOTE IS
  92      BEGIN
  93           RETURN  (NEW NOTE);
  94      END F;
  95
  96      FUNCTION G IS NEW F1 (NEW_CHAR, 'G');
  97      FUNCTION G IS NEW F1 (NEW_DUR,  1.0);
  98      FUNCTION G IS NEW F1 (NEW_POS,  +10);
  99      FUNCTION G IS NEW F1 (NEW_INT,  -10);
 100      FUNCTION G IS NEW F1 (NEW_BOOL, TRUE);
 101      FUNCTION G IS NEW F1 (NEW_FLT,  1.0);
 102      FUNCTION G IS NEW F1 (NEW_NOTE, F);
 103
 104 BEGIN
 105      TEST ("C87B41A","OVERLOADED CONSTRUCTS ON BOTH SIDES OF THE " &
 106            "ASSIGNMENT STATEMENT");
 107
 108      F.ALL := G;
 109
 110      RESULT;
 111
 112 END C87B41A;