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
34WITH REPORT; USE REPORT;
35PROCEDURE 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
59BEGIN
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
132EXCEPTION
133     WHEN OTHERS =>
134          FAILED("UNEXPECTED EXCEPTION RAISED");
135          RESULT;
136END C85006G;
137