1-- C64104A.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-- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR 27-- ARGUMENTS. SUBTESTS ARE: 28-- (A) STATIC IN ARGUMENT. 29-- (B) DYNAMIC IN ARGUMENT. 30-- (C) IN OUT, OUT OF RANGE ON CALL. 31-- (D) OUT, OUT OF RANGE ON RETURN. 32-- (E) IN OUT, OUT OF RANGE ON RETURN. 33 34-- HISTORY: 35-- DAS 01/14/81 36-- CPP 07/03/84 37-- LB 11/20/86 ADDED CODE TO ENSURE IN SUBTESTS WHICH CHECK 38-- RETURNED VALUES, THAT SUBPROGRAMS ARE ACTUALLY 39-- CALLED. 40-- JET 08/04/87 FIXED HEADER FOR STANDARD FORMAT. 41 42WITH REPORT; USE REPORT; 43PROCEDURE C64104A IS 44 45 SUBTYPE DIGIT IS INTEGER RANGE 0..9; 46 47 CALLED : BOOLEAN; 48 D : DIGIT; 49 I : INTEGER; 50 M1 : CONSTANT INTEGER := IDENT_INT(-1); 51 COUNT : INTEGER := 0; 52 SUBTYPE SI IS INTEGER RANGE M1 .. 10; 53 54 PROCEDURE P1 (PIN : IN DIGIT; WHO : STRING) IS -- (A), (B) 55 BEGIN 56 FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P1 " & WHO); 57 EXCEPTION 58 WHEN OTHERS => 59 FAILED ("EXCEPTION RAISED IN P1 FOR " & WHO); 60 END P1; 61 62 PROCEDURE P2 (PINOUT : IN OUT DIGIT; WHO : STRING) IS -- (C) 63 BEGIN 64 FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P2 " & WHO); 65 EXCEPTION 66 WHEN OTHERS => 67 FAILED ("EXCEPTION RAISED IN P2 FOR " & WHO); 68 END P2; 69 70 PROCEDURE P3 (POUT : OUT SI; WHO : STRING) IS -- (D) 71 BEGIN 72 IF WHO = "10" THEN 73 POUT := IDENT_INT(10); -- (10 IS NOT A DIGIT) 74 ELSE 75 POUT := -1; 76 END IF; 77 CALLED := TRUE; 78 EXCEPTION 79 WHEN OTHERS => 80 FAILED ("EXCEPTION RAISED IN P3 FOR " & WHO); 81 END P3; 82 83 PROCEDURE P4 (PINOUT : IN OUT INTEGER; WHO : STRING) IS -- (E) 84 BEGIN 85 IF WHO = "10" THEN 86 PINOUT := 10; -- (10 IS NOT A DIGIT) 87 ELSE 88 PINOUT := IDENT_INT(-1); 89 END IF; 90 CALLED := TRUE; 91 EXCEPTION 92 WHEN OTHERS => 93 FAILED ("EXCEPTION RAISED IN P4 FOR" & WHO); 94 END P4; 95 96BEGIN 97 98 TEST ("C64104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " & 99 "FOR OUT OF RANGE SCALAR ARGUMENTS"); 100 101 BEGIN -- (A) 102 P1 (10, "10"); 103 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (10)"); 104 EXCEPTION 105 WHEN CONSTRAINT_ERROR => 106 COUNT := COUNT + 1; 107 WHEN OTHERS => 108 FAILED ("WRONG EXCEPTION RAISED FOR P1 (10)"); 109 END; -- (A) 110 111 BEGIN -- (B) 112 P1 (IDENT_INT (-1), "-1"); 113 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (" & 114 "IDENT_INT (-1))"); 115 EXCEPTION 116 WHEN CONSTRAINT_ERROR => 117 COUNT := COUNT + 1; 118 WHEN OTHERS => 119 FAILED ("WRONG EXCEPTION RAISED FOR P1 (" & 120 "IDENT_INT (-1))"); 121 END; --(B) 122 123 BEGIN -- (C) 124 I := IDENT_INT (10); 125 P2 (I, "10"); 126 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (10)"); 127 EXCEPTION 128 WHEN CONSTRAINT_ERROR => 129 COUNT := COUNT + 1; 130 WHEN OTHERS => 131 FAILED ("WRONG EXCEPTION RAISED FOR P2 (10)"); 132 END; -- (C) 133 134 BEGIN -- (C1) 135 I := IDENT_INT (-1); 136 P2 (I, "-1"); 137 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (-1)"); 138 EXCEPTION 139 WHEN CONSTRAINT_ERROR => 140 COUNT := COUNT + 1; 141 WHEN OTHERS => 142 FAILED ("WRONG EXCEPTION RAISED FOR P2 (-1)"); 143 END; -- (C1) 144 145 BEGIN -- (D) 146 CALLED := FALSE; 147 D := IDENT_INT (1); 148 P3 (D, "10"); 149 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" & 150 " P3 (10)"); 151 EXCEPTION 152 WHEN CONSTRAINT_ERROR => 153 COUNT := COUNT + 1; 154 IF NOT CALLED THEN 155 FAILED ("SUBPROGRAM P3 WAS NOT CALLED"); 156 END IF; 157 WHEN OTHERS => 158 FAILED ("WRONG EXCEPTION RAISED FOR P3 (10)"); 159 END; -- (D) 160 161 BEGIN -- (D1) 162 CALLED := FALSE; 163 D := IDENT_INT (1); 164 P3 (D, "-1"); 165 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" & 166 " P3 (-1)"); 167 EXCEPTION 168 WHEN CONSTRAINT_ERROR => 169 COUNT := COUNT + 1; 170 IF NOT CALLED THEN 171 FAILED ("SUBPROGRAM P3 WAS NOT CALLED"); 172 END IF; 173 WHEN OTHERS => 174 FAILED ("WRONG EXCEPTION RAISED FOR P3 (-1)"); 175 END; -- (D1) 176 177 BEGIN -- (E) 178 CALLED := FALSE; 179 D := 9; 180 P4 (D, "10"); 181 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" & 182 " P4 (10)"); 183 EXCEPTION 184 WHEN CONSTRAINT_ERROR => 185 COUNT := COUNT + 1; 186 IF NOT CALLED THEN 187 FAILED ("SUBPROGRAM P4 WAS NOT CALLED"); 188 END IF; 189 WHEN OTHERS => 190 FAILED ("WRONG EXCEPTION RAISED FOR P4 (10)"); 191 END; -- (E) 192 193 BEGIN -- (E1) 194 CALLED := FALSE; 195 D := 0; 196 P4 (D, "-1"); 197 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" & 198 " P4 (-1)"); 199 EXCEPTION 200 WHEN CONSTRAINT_ERROR => 201 COUNT := COUNT + 1; 202 IF NOT CALLED THEN 203 FAILED ("SUBPROGRAM P4 WAS NOT CALLED"); 204 END IF; 205 WHEN OTHERS => 206 FAILED ("WRONG EXCEPTION RAISED FOR P4 (-1)"); 207 END; -- (E1) 208 209 IF (COUNT /= 8) THEN 210 FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED"); 211 END IF; 212 213 RESULT; 214 215END C64104A; 216