1-- CC1221A.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:  ASSIGNMENT, MEMBERSHIP, QUALIFICATION,
29--     AND EXPLICIT CONVERSION TO AND FROM OTHER INTEGER TYPES.
30
31-- HISTORY:
32--     RJW 09/26/86  CREATED ORIGINAL TEST.
33--     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  SPLIT TEST
34--                   INTO PARTS A, B, C, AND D.
35
36WITH SYSTEM; USE SYSTEM;
37WITH REPORT; USE REPORT;
38PROCEDURE CC1221A IS
39
40     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
41     TYPE NEWINT IS NEW INTEGER;
42     TYPE INT IS RANGE -300 .. 300;
43
44BEGIN
45     TEST ( "CC1221A", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
46                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
47                       "DECLARED AND ARE THEREFORE AVAILABLE " &
48                       "WITHIN THE GENERIC UNIT:  ASSIGNMENT, " &
49                       "MEMBERSHIP, QUALIFICATION, AND EXPLICIT " &
50                       "CONVERSION TO AND FROM OTHER INTEGER TYPES");
51
52     DECLARE -- (A) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
53             --     PART I.
54
55          GENERIC
56               TYPE T IS RANGE <>;
57               TYPE T1 IS RANGE <>;
58               I  : T;
59               I1 : T1;
60          PROCEDURE P (J : T; STR : STRING);
61
62          PROCEDURE P (J : T; STR : STRING) IS
63               SUBTYPE ST IS T RANGE T'VAL (-1) .. T'VAL (1);
64               K, L  : T;
65
66               FUNCTION F (X : T) RETURN BOOLEAN IS
67               BEGIN
68                    RETURN IDENT_BOOL (TRUE);
69               END F;
70
71               FUNCTION F (X : T1) RETURN BOOLEAN IS
72               BEGIN
73                    RETURN IDENT_BOOL (FALSE);
74               END F;
75
76          BEGIN
77               K := I;
78               L := J;
79               K := L;
80
81               IF K /= J THEN
82                    FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
83                             "WITH TYPE - " & STR);
84               END IF;
85
86               IF I IN ST THEN
87                    NULL;
88               ELSE
89                    FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
90                             "TYPE  - " & STR);
91               END IF;
92
93               IF J NOT IN ST THEN
94                    NULL;
95               ELSE
96                    FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
97                             "TYPE  - " & STR);
98               END IF;
99
100               IF T'(I) /= I THEN
101                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
102                             "WITH TYPE - " & STR & " - 1" );
103               END IF;
104
105               IF F (T'(1)) THEN
106                    NULL;
107               ELSE
108                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
109                             "WITH TYPE - " & STR & " - 2" );
110               END IF;
111
112               IF T (I1) /= I THEN
113                    FAILED ( "INCORRECT RESULTS FOR EXPLICIT " &
114                             "CONVERSION WITH TYPE - " & STR &
115                             " - 1" );
116               END IF;
117
118               IF F (T (I1)) THEN
119                    NULL;
120               ELSE
121                    FAILED ( "INCORRECT RESULTS FOR EXPLICIT  " &
122                             "CONVERSION WITH TYPE - " & STR &
123                             " - 2" );
124               END IF;
125
126          END P;
127
128          PROCEDURE NP1 IS NEW P (SUBINT,  SUBINT,  0, 0);
129          PROCEDURE NP2 IS NEW P (NEWINT,  NEWINT,  0, 0);
130          PROCEDURE NP3 IS NEW P (INT,     INT,     0, 0);
131          PROCEDURE NP4 IS NEW P (INTEGER, INTEGER, 0, 0);
132
133     BEGIN
134          NP1 (2, "SUBINT");
135          NP2 (2, "NEWINT");
136          NP3 (2, "INT");
137          NP4 (2, "INTEGER");
138     END; -- (A).
139
140     RESULT;
141END CC1221A;
142