gcc/testsuite/ada/acats/tests/c7/c74402b.ada

   1 -- C74402B.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 INITIALIZATION OF IN PARAMETERS THAT ARE OF
  26 -- LIMITED PRIVATE TYPE IS PERMITTED.
  27 -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
  28
  29 -- DAS  1/21/81
  30 -- ABW  6/30/82
  31 -- BHS  7/10/84
  32
  33 WITH REPORT;
  34 PROCEDURE C74402B IS
  35
  36      USE REPORT;
  37
  38 BEGIN
  39
  40      TEST( "C74402B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
  41                        "OF LIMITED PRIVATE TYPE IS PERMITTED" );
  42
  43      DECLARE
  44
  45           PACKAGE PKG IS
  46
  47                TYPE LPTYPE IS LIMITED PRIVATE;
  48                CLP : CONSTANT LPTYPE;
  49                XLP : CONSTANT LPTYPE;
  50                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN;
  51                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN;
  52
  53           PRIVATE
  54
  55                TYPE LPTYPE IS NEW INTEGER RANGE 0..127;
  56                CLP : CONSTANT LPTYPE := 127;
  57                XLP : CONSTANT LPTYPE := 0;
  58
  59           END;
  60
  61           PACKAGE BODY PKG IS
  62
  63                FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN IS
  64                BEGIN
  65                     RETURN (L = CLP);
  66                END EQCLP;
  67
  68                FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN IS
  69                BEGIN
  70                     RETURN (L = XLP);
  71                END EQXLP;
  72
  73           END PKG;
  74
  75           USE PKG;
  76
  77           PROCEDURE PROC1 (Y : IN LPTYPE := CLP) IS
  78           BEGIN
  79                IF (EQCLP (Y)) THEN
  80                     FAILED( "LIMITED PRIVATE NOT PASSED, " &
  81                             "DEFAULT CLP EMPLOYED" );
  82                ELSIF (NOT EQXLP (Y)) THEN
  83                     FAILED( "NO LIMITED PRIVATE FOUND" );
  84                END IF;
  85           END PROC1;
  86
  87           PROCEDURE PROC2 (Y : IN LPTYPE := CLP) IS
  88           BEGIN
  89                IF (NOT EQCLP(Y)) THEN
  90                     FAILED( "DEFAULT NOT EMPLOYED" );
  91                END IF;
  92           END PROC2;
  93
  94      BEGIN
  95
  96           PROC1(XLP);
  97           PROC2;
  98
  99      END;
 100
 101      RESULT;
 102
 103 END C74402B;