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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c45210a.ada] - Blame information for rev 154

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C45210A.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 AN ENUMERATION IMPOSING AN "UNNATURAL" ORDER ON ALPHABETIC
26
--    CHARACTERS CORRECTLY EVALUATES THE ORDERING OPERATORS.
27
 
28
 
29
-- RM    15 OCTOBER 1980
30
-- JWC 7/8/85   RENAMED TO -AB
31
 
32
 
33
WITH  REPORT ;
34
PROCEDURE  C45210A  IS
35
 
36
     USE REPORT;
37
 
38
     TYPE  T  IS  ( 'S' , 'P' , 'M' , 'R' );
39
 
40
     MVAR  : T := T'('M') ;
41
     PVAR  : T := T'('P') ;
42
     RVAR  : T := T'('R') ;
43
     SVAR  : T := T'('S') ;
44
 
45
     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
46
 
47
     PROCEDURE  BUMP  IS
48
     BEGIN
49
          ERROR_COUNT := ERROR_COUNT +1 ;
50
     END BUMP ;
51
 
52
 
53
BEGIN
54
 
55
     TEST( "C45210A" , "CHECK THAT AN ENUMERATION IMPOSING" &
56
                       " AN ""UNNATURAL"" ORDER ON ALPHABETIC" &
57
                       " CHARACTERS  CORRECTLY EVALUATES THE " &
58
                       " ORDERING OPERATORS" ) ;
59
 
60
     -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
61
     --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
62
     --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
63
     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
64
     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
65
     --                         (IN THE TABLE:  VV = ALPHA ,
66
     --                                         VL = BETA  ,
67
     --                                         LV = GAMMA ,
68
     --                                         LL = DELTA  ) RANDOMIZED
69
     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
70
     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
71
 
72
     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
73
     --         LEFT
74
     --       OPERAND:
75
 
76
     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
77
     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
78
     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
79
     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
80
 
81
     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
82
     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
83
 
84
     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
85
     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
86
     --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
87
 
88
    -----------------------------------------------------------------
89
 
90
     -- PART 1
91
 
92
     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
93
 
94
     IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
95
     IF  T'(SVAR) <= T'('P' )  THEN  NULL;  ELSE  BUMP ;  END IF;
96
     IF  T'('S' ) >  T'(MVAR)  THEN  BUMP ;               END IF;
97
     IF  T'('S' ) >= T'('R' )  THEN  BUMP ;               END IF;
98
 
99
     IF  T'('P' ) >  T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
100
     IF  T'('P' ) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
101
     IF  T'(PVAR) <  T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
102
     IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
103
 
104
     IF  T'(MVAR) >= T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
105
     IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
106
     IF  T'('M' ) <= T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
107
     IF  T'('M' ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
108
 
109
     IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
110
     IF  T'('R' ) <  T'('P' )  THEN  BUMP ;               END IF;
111
     IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
112
     IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
113
 
114
 
115
     IF  ERROR_COUNT /= 0  THEN
116
          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE1" );
117
     END IF;
118
 
119
    -----------------------------------------------------------------
120
 
121
     -- PART 2
122
 
123
     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
124
 
125
     ERROR_COUNT := 0 ;
126
 
127
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
128
          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
129
 
130
               IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  1
131
 
132
          END LOOP;
133
     END LOOP;
134
 
135
     IF  ERROR_COUNT /= 1  THEN   -- THIS IS A PLAIN COUNT, NOT AN
136
                                   --    ERROR COUNT
137
          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE2" );
138
     END IF;
139
 
140
 
141
     ERROR_COUNT := 0 ;
142
 
143
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
144
          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
145
 
146
               IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  3
147
 
148
          END LOOP;
149
     END LOOP;
150
 
151
     IF  ERROR_COUNT /= 3  THEN   -- THIS IS A PLAIN COUNT, NOT AN
152
                                   --    ERROR COUNT
153
          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE3" );
154
     END IF;
155
 
156
 
157
     ERROR_COUNT := 0 ;
158
 
159
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
160
          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
161
 
162
               IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  5
163
 
164
          END LOOP;
165
     END LOOP;
166
 
167
     IF  ERROR_COUNT /= 5  THEN   -- THIS IS A PLAIN COUNT, NOT AN
168
                                   --    ERROR COUNT
169
          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE4" );
170
     END IF;
171
 
172
 
173
     ERROR_COUNT := 0 ;
174
 
175
     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
176
          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
177
 
178
               IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  7
179
 
180
          END LOOP;
181
     END LOOP;
182
 
183
     IF  ERROR_COUNT /= 7  THEN   -- THIS IS A PLAIN COUNT, NOT AN
184
                                   --    ERROR COUNT
185
          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE5" );
186
     END IF;
187
 
188
 
189
     RESULT;
190
 
191
END C45210A;

powered by: WebSVN 2.1.0

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