gcc/testsuite/ada/acats/tests/c8/c85006g.ada

   1 -- C85006G.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 ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
  27 --     IN THE SLICE RENAMING DECLARATION IS IGNORED, AND THAT THE
  28 --     SUBTYPE CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS
  29 --     USED INSTEAD.
  30
  31 -- HISTORY:
  32 --     JET 07/26/88  CREATED ORIGINAL TEST.
  33
  34 WITH REPORT; USE REPORT;
  35 PROCEDURE C85006G IS
  36
  37      SUBTYPE STR IS STRING(1..10);
  38
  39      S : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
  40      T : STR := IDENT_STR("0123456789");
  41
  42      DG1 : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
  43      DG2 : STR := IDENT_STR("0123456789");
  44
  45      XS : STR RENAMES S(10..24);
  46      XT : STRING RENAMES T(1..5);
  47
  48      GENERIC
  49           G1 : IN OUT STR;
  50           G2 : IN OUT STRING;
  51      PACKAGE GEN IS
  52           XG1 : STR RENAMES G1(10..24);
  53           XG2 : STRING RENAMES G2(1..5);
  54      END GEN;
  55
  56      PACKAGE PACK IS NEW GEN(DG1, DG2);
  57      USE PACK;
  58
  59 BEGIN
  60      TEST ("C85006G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
  61                       "THE TYPE MARK USED IN THE SLICE RENAMING " &
  62                       "DECLARATION IS IGNORED, AND THAT THE SUBTYPE " &
  63                       "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
  64                       "VARIABLE IS USED INSTEAD");
  65
  66      IF XS'FIRST /= IDENT_INT(10) OR
  67         XS'LAST /= IDENT_INT(24) OR
  68         XS'LENGTH /= IDENT_INT(15) THEN
  69           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 1");
  70      END IF;
  71
  72      IF XS /= "DARK AND STORMY" THEN
  73           FAILED("INCORRECT VALUE OF RENAMING SLICE - 1");
  74      END IF;
  75
  76      XS := IDENT_STR("STORMY AND DARK");
  77
  78      IF S /= "IT WAS A STORMY AND DARK NIGHT" THEN
  79           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 1");
  80      END IF;
  81
  82      IF XT'FIRST /= IDENT_INT(1) OR
  83         XT'LAST /= IDENT_INT(5) OR
  84         XT'LENGTH /= IDENT_INT(5) THEN
  85           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 2");
  86      END IF;
  87
  88      IF XT /= "01234" THEN
  89           FAILED("INCORRECT VALUE OF RENAMING SLICE - 2");
  90      END IF;
  91
  92      XT := IDENT_STR("43210");
  93
  94      IF T /= "4321056789" THEN
  95           FAILED("INCORRECT VALUE OF ORIGINAL STRING - 2");
  96      END IF;
  97
  98      IF XG1'FIRST /= IDENT_INT(10) OR
  99         XG1'LAST /= IDENT_INT(24) OR
 100         XG1'LENGTH /= IDENT_INT(15) THEN
 101           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G1");
 102      END IF;
 103
 104      IF XG1 /= "DARK AND STORMY" THEN
 105           FAILED("INCORRECT VALUE OF RENAMING SLICE - G1");
 106      END IF;
 107
 108      XG1 := IDENT_STR("STORMY AND DARK");
 109
 110      IF DG1 /= "IT WAS A STORMY AND DARK NIGHT" THEN
 111           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G1");
 112      END IF;
 113
 114      IF XG2'FIRST /= IDENT_INT(1) OR
 115         XG2'LAST /= IDENT_INT(5) OR
 116         XG2'LENGTH /= IDENT_INT(5) THEN
 117           FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G2");
 118      END IF;
 119
 120      IF XG2 /= "01234" THEN
 121           FAILED("INCORRECT VALUE OF RENAMING SLICE - G2");
 122      END IF;
 123
 124      XG2 := IDENT_STR("43210");
 125
 126      IF DG2 /= "4321056789" THEN
 127           FAILED("INCORRECT VALUE OF ORIGINAL STRING - G2");
 128      END IF;
 129
 130      RESULT;
 131
 132 EXCEPTION
 133      WHEN OTHERS =>
 134           FAILED("UNEXPECTED EXCEPTION RAISED");
 135           RESULT;
 136 END C85006G;