1-- C45201B.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 THE ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE
26--    ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE
27--    LITERALS IN THE TYPE DEFINITION.
28
29-- THIS TEST IS DERIVED FROM  C45210A.ADA .
30
31
32-- RM    17 OCTOBER 1980
33-- JWC 7/8/85   RENAMED TO -AB
34
35
36WITH  REPORT ;
37PROCEDURE  C45201B  IS
38
39     USE REPORT;
40
41     TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
42
43     --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
44     --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
45
46     SUBTYPE  T1  IS  T RANGE A..B ;
47     SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
48     SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
49     SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
50
51     MVAR  : T3 := T'(NUL ) ;
52     PVAR  : T2 := T'(PLIT) ;
53     RVAR  : T4 := T'('R' ) ;
54     SVAR  : T1 := T'(SLIT) ;
55
56     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
57
58     PROCEDURE  BUMP  IS
59     BEGIN
60          ERROR_COUNT := ERROR_COUNT + 1 ;
61     END BUMP ;
62
63
64BEGIN
65
66     TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "&
67                     " AS DEFINED BY THE ORDERING OPERATORS" &
68                     " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " &
69                     " LITERALS IN THE TYPE DEFINITION" ) ;
70
71     -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
72     --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
73     --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
74     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
75     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
76     --                         (IN THE TABLE:  VV = ALPHA ,
77     --                                         VL = BETA  ,
78     --                                         LV = GAMMA ,
79     --                                         LL = DELTA  ) RANDOMIZED
80     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
81     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
82
83     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
84     --         LEFT
85     --       OPERAND:
86
87     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
88     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
89     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
90     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
91
92     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
93     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
94
95     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
96     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
97     --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
98
99    -----------------------------------------------------------------
100
101     -- PART 1
102
103     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
104
105     IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
106     IF  T'(SVAR) <= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
107     IF  T'(SLIT) >  T'(MVAR)  THEN  BUMP ;               END IF;
108     IF  T'(SLIT) >= T'('R' )  THEN  BUMP ;               END IF;
109
110     IF  T'(PLIT) >  T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
111     IF  T'(PLIT) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
112     IF  T'(PVAR) <  T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
113     IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
114
115     IF  T'(MVAR) >= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
116     IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
117     IF  T'(NUL ) <= T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
118     IF  T'(NUL ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
119
120     IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
121     IF  T'('R' ) <  T'(PLIT)  THEN  BUMP ;               END IF;
122     IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
123     IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
124
125
126     IF  ERROR_COUNT /= 0  THEN
127          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" );
128     END IF;
129
130    -----------------------------------------------------------------
131
132     -- PART 2
133
134     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
135
136     ERROR_COUNT := 0 ;
137
138     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
139          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
140
141               IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  6
142
143          END LOOP;
144     END LOOP;
145
146     IF  ERROR_COUNT /= 6  THEN   -- THIS IS A PLAIN COUNT, NOT AN
147                                   --    ERROR COUNT
148          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" );
149     END IF;
150
151
152     ERROR_COUNT := 0 ;
153
154     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
155          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
156
157               IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 10
158
159          END LOOP;
160     END LOOP;
161
162     IF  ERROR_COUNT /=10  THEN   -- THIS IS A PLAIN COUNT, NOT AN
163                                   --    ERROR COUNT
164          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" );
165     END IF;
166
167
168     ERROR_COUNT := 0 ;
169
170     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
171          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
172
173               IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 26
174
175          END LOOP;
176     END LOOP;
177
178     IF  ERROR_COUNT /=26  THEN   -- THIS IS A PLAIN COUNT, NOT AN
179                                   --    ERROR COUNT
180          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" );
181     END IF;
182
183
184     ERROR_COUNT := 0 ;
185
186     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
187          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
188
189               IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 30
190
191          END LOOP;
192     END LOOP;
193
194     IF  ERROR_COUNT /=30  THEN   -- THIS IS A PLAIN COUNT, NOT AN
195                                   --    ERROR COUNT
196          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" );
197     END IF;
198
199
200     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT' (AGAIN)
201
202     ERROR_COUNT := 0 ;
203
204     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
205
206          FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
207
208               IF ( AVAR <  BVAR ) /= ( T'POS(AVAR) <  T'POS(BVAR) )THEN
209                    BUMP ;
210               END IF;
211
212               IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN
213                    BUMP ;
214               END IF;
215
216               IF ( AVAR >  BVAR ) /= ( T'POS(AVAR) >  T'POS(BVAR) )THEN
217                    BUMP ;
218               END IF;
219
220               IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN
221                    BUMP ;
222               END IF;
223
224          END LOOP;
225
226     END LOOP;
227
228
229     IF  ERROR_COUNT /= 0  THEN   -- REAL ERROR COUNT AGAIN
230          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" );
231     END IF;
232
233
234     RESULT;
235
236END C45201B;
237