1-- C43215B.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 CONSTRAINT_ERROR IS RAISED WHEN THE UPPER BOUND 26-- OF A POSITIONAL AGGREGATE DOES NOT BELONG TO THE INDEX BASE TYPE. 27 28-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 29-- *** remove incompatibilities associated with the transition -- 9X 30-- *** to Ada 9X. -- 9X 31 32-- EG 02/13/84 33-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST. 34 35WITH REPORT; 36WITH SYSTEM; 37 38PROCEDURE C43215B IS 39 40 USE REPORT; 41 USE SYSTEM; 42 43BEGIN 44 45 TEST("C43215B","CHECK THAT CONSTRAINT_ERROR IS RAISED " & 46 "WHEN THE UPPER BOUND OF A POSITIONAL ARRAY " & 47 "AGGREGATE DOES NOT BELONG TO THE INDEX " & 48 "BASE TYPE"); 49 50 BEGIN 51 52CASE_A : DECLARE 53 54 LOWER_BOUND : CONSTANT := MAX_INT-3; 55 UPPER_BOUND : CONSTANT := MAX_INT-1; 56 57 TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND; 58 59 TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER; 60 61 A1 : TA(STA); 62 OK : EXCEPTION; 63 64 FUNCTION FUN1 RETURN TA IS 65 BEGIN 66 RETURN (1, 2, 3, 4, 5); 67 EXCEPTION 68 WHEN CONSTRAINT_ERROR => 69 BEGIN 70 COMMENT ("CASE A : CONSTRAINT_ERROR RAISED"); 71 RAISE OK; 72 END; 73 WHEN OTHERS => 74 BEGIN 75 FAILED ("CASE A : EXCEPTION RAISED IN FUN1"); 76 RAISE OK; 77 END; 78 END FUN1; 79 80 BEGIN 81 82 A1 := FUN1; 83 FAILED ("CASE A : CONSTRAINT OR NUMERIC ERROR WAS " & 84 "NOT RAISED"); 85 86 EXCEPTION 87 88 WHEN OK => 89 NULL; 90 91 WHEN OTHERS => 92 FAILED ("CASE A : WRONG EXCEPTION RAISED"); 93 94 END CASE_A; 95 96CASE_B : DECLARE 97 98 TYPE ENUM IS (A, B, C, D); 99 100 SUBTYPE STB IS ENUM RANGE A .. C; 101 102 TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER; 103 104 B1 : TB(STB); 105 OK : EXCEPTION; 106 107 FUNCTION FUN1 RETURN TB IS 108 BEGIN 109 RETURN (1, 2, 3, 4, 5); 110 EXCEPTION 111 WHEN CONSTRAINT_ERROR => 112 BEGIN 113 COMMENT ("CASE B : CONSTRAINT_ERROR RAISED"); 114 RAISE OK; 115 END; 116 WHEN OTHERS => 117 BEGIN 118 FAILED ("CASE B : EXCEPTION RAISED IN FUN1"); 119 RAISE OK; 120 END; 121 END FUN1; 122 123 BEGIN 124 125 B1 := FUN1; 126 FAILED ("CASE B : CONSTRAINT ERROR WAS NOT RAISED"); 127 128 EXCEPTION 129 130 WHEN OK => 131 NULL; 132 133 WHEN OTHERS => 134 FAILED ("CASE B : WRONG EXCEPTION RAISED"); 135 136 END CASE_B; 137 138 END; 139 140 RESULT; 141 142END C43215B; 143