OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c45201a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
-- C45201A.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  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
26
--    ENUMERATION-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
27
--    DIFFERENT SUBTYPES).
28
 
29
-- THIS TEST'S FRAMEWORK IS FROM  C45201B.ADA , C45210A.ADA .
30
 
31
 
32
-- RM    20 OCTOBER 1980
33
-- JWC 7/8/85   RENAMED TO -AB
34
 
35
 
36
WITH  REPORT ;
37
PROCEDURE  C45201A  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
     FUNCTION  ITSELF( THE_ARGUMENT : T )  RETURN  T  IS
64
     BEGIN
65
          IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
66
          ELSE  RETURN  A ;
67
          END IF;
68
     END ;
69
 
70
 
71
BEGIN
72
 
73
     TEST( "C45201A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
74
                       " RESULTS ON ENUMERATION-TYPE LITERALS" ) ;
75
 
76
     -- 128 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
77
     --             2 (4)  OPERATORS (2, TWICE): '=' , '/=' , '=' , '/='
78
     --                          (IN THE TABLE:   A  ,  B   ,  C  ,  D )
79
     --                          (C45201B.ADA HAD  < <= > >= ; REVERSED)
80
     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
81
     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
82
     --                         (IN THE TABLE:  VV = ALPHA ,
83
     --                                         VL = BETA  ,
84
     --                                         LV = GAMMA ,
85
     --                                         LL = DELTA  ) RANDOMIZED
86
     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
87
     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
88
 
89
     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
90
     --         LEFT
91
     --       OPERAND:
92
 
93
     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
94
     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
95
     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
96
     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
97
 
98
     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
99
     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
100
 
101
     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
102
     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
103
     --    ( VV , ALPHA ) FOR BOTH OPERATORS.
104
 
105
    -----------------------------------------------------------------
106
 
107
     -- PART 1
108
 
109
     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
110
 
111
     IF  T'(SVAR) =  T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
112
     IF  T'(SVAR) /= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
113
     IF  T'(SLIT) =  T'(MVAR)  THEN  BUMP ;               END IF;
114
     IF  T'(SLIT) /= T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
115
 
116
     IF  T'(PLIT) =  T'(SLIT)  THEN  BUMP ;               END IF;
117
     IF  T'(PLIT) /= T'(PVAR)  THEN  BUMP ;               END IF;
118
     IF  T'(PVAR) =  T'(NUL )  THEN  BUMP ;               END IF;
119
     IF  T'(PVAR) /= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
120
 
121
     IF  T'(MVAR) /= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
122
     IF  T'(MVAR) =  T'(PVAR)  THEN  BUMP ;               END IF;
123
     IF  T'(NUL ) /= T'(NUL )  THEN  BUMP ;               END IF;
124
     IF  T'(NUL ) =  T'(RVAR)  THEN  BUMP ;               END IF;
125
 
126
     IF  T'('R' ) /= T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
127
     IF  T'('R' ) =  T'(PLIT)  THEN  BUMP ;               END IF;
128
     IF  T'(RVAR) /= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
129
     IF  T'(RVAR) =  T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
130
 
131
 
132
     IF  ERROR_COUNT /= 0  THEN
133
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE1" );
134
     END IF;
135
 
136
    -----------------------------------------------------------------
137
 
138
     -- PART 2
139
 
140
     --  'BUMP'  STILL MEANS  'BUMP THE ERROR COUNT'
141
 
142
     ERROR_COUNT := 0 ;
143
 
144
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
145
          FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
146
 
147
               IF  AVAR  = BVAR  THEN
148
                    IF  AVAR /= BVAR  THEN  BUMP ;  END IF;
149
               END IF;
150
 
151
               IF  AVAR /= BVAR  THEN
152
                    IF  AVAR  = BVAR  THEN  BUMP ;  END IF;
153
               END IF;
154
 
155
          END LOOP;
156
     END LOOP;
157
 
158
     IF  ERROR_COUNT /= 0  THEN
159
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE2" );
160
     END IF;
161
 
162
 
163
     ERROR_COUNT := 0 ;
164
 
165
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
166
 
167
          FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
168
 
169
               IF ( AVAR /= BVAR ) /= ( T'POS(AVAR) /= T'POS(BVAR) )THEN
170
                    BUMP ;
171
               END IF;
172
 
173
               IF ( AVAR  = BVAR ) /= ( T'POS(AVAR)  = T'POS(BVAR) )THEN
174
                    BUMP ;
175
               END IF;
176
 
177
          END LOOP;
178
 
179
     END LOOP;
180
 
181
     IF  ERROR_COUNT /= 0  THEN
182
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE3" );
183
     END IF;
184
 
185
     ERROR_COUNT := 0 ;
186
 
187
     FOR  IVAR IN  0..8  LOOP                      -- 9 VALUES
188
 
189
          FOR  JVAR  IN  0..8   LOOP               -- 9 VALUES
190
 
191
               IF ( IVAR /= JVAR ) /= ( T'VAL(IVAR) /= T'VAL(JVAR) )THEN
192
                    BUMP ;
193
               END IF;
194
 
195
               IF ( IVAR  = JVAR ) /= ( T'VAL(IVAR)  = T'VAL(JVAR) )THEN
196
                    BUMP ;
197
               END IF;
198
 
199
          END LOOP;
200
 
201
     END LOOP;
202
 
203
     IF  ERROR_COUNT /= 0  THEN
204
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE4" );
205
     END IF;
206
 
207
 
208
     ERROR_COUNT := 0 ;
209
 
210
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP    -- 9 VALUES (THE DIAGONAL)
211
 
212
          IF  AVAR  = ITSELF(AVAR)  THEN NULL;  ELSE BUMP;  END IF;
213
          IF  AVAR /= ITSELF(AVAR)  THEN BUMP;              END IF;
214
 
215
     END LOOP;
216
 
217
     IF  ERROR_COUNT /= 0  THEN
218
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE5" );
219
     END IF;
220
 
221
 
222
     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
223
 
224
     ERROR_COUNT := 0 ;
225
 
226
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
227
          FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
228
 
229
               IF  AVAR /= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 72
230
 
231
          END LOOP;
232
     END LOOP;
233
 
234
     IF  ERROR_COUNT /= 72  THEN   -- THIS IS A PLAIN COUNT, NOT AN
235
                                   --    ERROR COUNT
236
          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE6" );
237
     END IF;
238
 
239
 
240
     RESULT;
241
 
242
END C45201A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.