old-autovect-branch/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada

   1 -- CA2011B.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 FOR A SUBPROGRAM DECLARATION-STUB-BODY TRIPLE, THE
  27 --     DECLARATION-STUB AND STUB-BODY SPECIFICATIONS CAN CONFORM, BUT
  28 --     THE DECLARATION-BODY SPECIFICATIONS NEED NOT.
  29
  30 -- HISTORY:
  31 --     JET 08/01/88  CREATED ORIGINAL TEST.
  32
  33 PACKAGE CA2011B0 IS
  34      SUBTYPE T IS INTEGER RANGE -100 .. 100;
  35      I : T := 0;
  36 END CA2011B0;
  37
  38 WITH CA2011B0; USE CA2011B0;
  39 PACKAGE CA2011B1 IS
  40      PROCEDURE P1 (X : CA2011B0.T);
  41      PROCEDURE P2 (X : T);
  42 END CA2011B1;
  43
  44 WITH REPORT; USE REPORT;
  45 PRAGMA ELABORATE (REPORT);
  46 PACKAGE BODY CA2011B1 IS
  47      PACKAGE CA2011BX RENAMES CA2011B0;
  48      PROCEDURE P1 (X : T) IS SEPARATE;
  49      PROCEDURE P2 (X : CA2011BX.T) IS SEPARATE;
  50 END CA2011B1;
  51
  52 SEPARATE (CA2011B1)
  53 PROCEDURE P1 (X : CA2011BX.T) IS
  54 BEGIN
  55      I := IDENT_INT(X);
  56 END P1;
  57
  58 SEPARATE (CA2011B1)
  59 PROCEDURE P2 (X : CA2011BX.T) IS
  60 BEGIN
  61      I := IDENT_INT(X);
  62 END P2;
  63
  64 WITH REPORT; USE REPORT;
  65 WITH CA2011B0, CA2011B1;
  66 PROCEDURE CA2011B IS
  67
  68      PACKAGE P1 IS
  69           SUBTYPE T IS INTEGER RANGE -100 .. 100;
  70      END P1;
  71      USE P1;
  72
  73      FUNCTION F1 RETURN P1.T;
  74      FUNCTION F2 RETURN T;
  75
  76      PACKAGE P2 RENAMES P1;
  77
  78      FUNCTION F1 RETURN T IS SEPARATE;
  79      FUNCTION F2 RETURN P2.T IS SEPARATE;
  80
  81 BEGIN
  82      TEST ("CA2011B", "CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-" &
  83                       "BODY TRIPLE, THE DECLARATION-STUB AND STUB-" &
  84                       "BODY SPECIFICATIONS CAN CONFORM, BUT THE " &
  85                       "DECLARATON-BODY SPECIFICATIONS NEED NOT");
  86
  87      IF F1 /= IDENT_INT(100) THEN
  88           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 1");
  89      END IF;
  90
  91      IF F2 /= IDENT_INT(-100) THEN
  92           FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 2");
  93      END IF;
  94
  95      CA2011B1.P1(3);
  96      IF CA2011B0.I /= IDENT_INT(3) THEN
  97           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 1");
  98      END IF;
  99
 100      CA2011B1.P2(4);
 101      IF CA2011B0.I /= IDENT_INT(4) THEN
 102           FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 2");
 103      END IF;
 104
 105      RESULT;
 106 END CA2011B;
 107
 108 SEPARATE (CA2011B)
 109 FUNCTION F1 RETURN P2.T IS
 110 BEGIN
 111      RETURN 100;
 112 END F1;
 113
 114 SEPARATE (CA2011B)
 115 FUNCTION F2 RETURN P2.T IS
 116 BEGIN
 117      RETURN -100;
 118 END F2;