1-- CC1221B.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--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
27--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
28--     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
29--     'ADDRESS, AND 'SIZE.
30
31-- HISTORY:
32--     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
33
34WITH SYSTEM; USE SYSTEM;
35WITH REPORT; USE REPORT;
36PROCEDURE CC1221B IS
37
38     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
39     SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
40     TYPE NEWINT IS NEW INTEGER;
41     TYPE INT IS RANGE -300 .. 300;
42     SUBTYPE SINT1 IS INT
43          RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
44     SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
45     TYPE INT2 IS RANGE 0E8 .. 1E3;
46
47BEGIN
48     TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
49                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
50                       "DECLARED AND ARE THEREFORE AVAILABLE " &
51                       "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
52                       "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
53
54     DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
55             --     PART II.
56
57          GENERIC
58               TYPE T IS RANGE <>;
59               F, L : T;
60               W : INTEGER;
61          PROCEDURE P (STR : STRING);
62
63          PROCEDURE P (STR : STRING) IS
64               I : INTEGER := F'SIZE;
65               T1 : T;
66               A : ADDRESS := T1'ADDRESS;
67
68          BEGIN
69               IF T'FIRST /= F THEN
70                    FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
71               END IF;
72
73               IF T'LAST /= L THEN
74                    FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
75               END IF;
76
77               IF T'BASE'FIRST > T'FIRST THEN
78                    FAILED ( "INCORRECT RESULTS WITH " & STR &
79                             "'BASE'FIRST" );
80               END IF;
81
82               IF T'BASE'LAST < T'LAST THEN
83                    FAILED ( "INCORRECT RESULTS WITH " & STR &
84                             "'BASE'LAST" );
85               END IF;
86
87               IF T'WIDTH /= W THEN
88                    FAILED ( "INCORRECT VALUE FOR " & STR &
89                             "'WIDTH" );
90               END IF;
91
92               IF T'BASE'WIDTH < T'WIDTH THEN
93                    FAILED ( "INCORRECT RESULTS WITH " & STR &
94                             "'BASE'WIDTH" );
95               END IF;
96
97          END P;
98
99          GENERIC
100               TYPE T IS RANGE <>;
101          PROCEDURE Q;
102
103          PROCEDURE Q IS
104          BEGIN
105               IF T'FIRST /= 1 THEN
106                    FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
107               END IF;
108
109               IF T'LAST /= -1 THEN
110                    FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
111               END IF;
112
113               IF T'BASE'FIRST > T'FIRST THEN
114                    FAILED ( "INCORRECT RESULTS WITH " &
115                             "NOINT'BASE'FIRST" );
116               END IF;
117
118               IF T'BASE'LAST < T'LAST THEN
119                    FAILED ( "INCORRECT RESULTS WITH " &
120                             "NOINT'BASE'LAST" );
121               END IF;
122
123               IF T'WIDTH /= 0 THEN
124                    FAILED ( "INCORRECT VALUE FOR " &
125                             "NOINT'WIDTH" );
126               END IF;
127
128               IF T'BASE'WIDTH < T'WIDTH THEN
129                    FAILED ( "INCORRECT RESULTS WITH " &
130                             "NOINT'BASE'WIDTH" );
131               END IF;
132
133          END Q;
134
135          PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
136                                 INTEGER'WIDTH);
137          PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
138          PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
139                                 NEWINT'WIDTH);
140          PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
141          PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
142          PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
143
144          PROCEDURE Q1 IS NEW Q (NOINT);
145
146     BEGIN
147           P1 ( "INTEGER" );
148           P2 ( "SUBINT" );
149           P3 ( "NEWINT" );
150           P4 ( "SINT1" );
151           P5 ( "SINT2" );
152           P6 ( "INT2" );
153
154           Q1;
155
156     END; -- (B).
157
158     RESULT;
159END CC1221B;
160