1-- 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 33WITH REPORT ; 34PROCEDURE 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 53BEGIN 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 191END C45210A; 192