1-- C48007C.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-- FOR ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS 26-- RAISED IF T IS A CONSTRAINED ARRAY TYPE AND AT LEAST ONE INDEX BOUND 27-- FOR T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE 28-- ALLOCATOR'S BASE TYPE. 29 30-- EG 08/10/84 31 32WITH REPORT; 33 34PROCEDURE C48007C IS 35 36 USE REPORT; 37 38BEGIN 39 40 TEST("C48007C","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " & 41 "THAT CONSTRAINT_ERROR IS RAISED WHEN " & 42 "APPROPRIATE - CONSTRAINED ARRAY TYPE"); 43 44 DECLARE 45 46 TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER; 47 TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF 48 INTEGER; 49 TYPE UA3 IS ARRAY(INTEGER RANGE <>) OF UA1(1 .. 2); 50 51 SUBTYPE CA11 IS UA1(1 .. 3); 52 SUBTYPE CA12 IS UA1(3 .. 2); 53 SUBTYPE CA21 IS UA2(1 .. 2, 1 .. 2); 54 SUBTYPE CA22 IS UA2(1 .. 2, 2 .. 0); 55 SUBTYPE CA31 IS UA3(1 .. 2); 56 SUBTYPE CA32 IS UA3(4 .. 1); 57 58 TYPE A_UA11 IS ACCESS UA1(2 .. 4); 59 TYPE A_UA12 IS ACCESS UA1(4 .. 3); 60 TYPE A_UA21 IS ACCESS UA2(1 .. 3, 1 .. 2); 61 TYPE A_UA22 IS ACCESS UA2(1 .. 2, 2 .. 1); 62 TYPE A_UA31 IS ACCESS UA3(1 .. 3); 63 TYPE A_UA32 IS ACCESS UA3(3 .. 1); 64 65 V11 : A_UA11; 66 V12 : A_UA12; 67 V21 : A_UA21; 68 V22 : A_UA22; 69 V31 : A_UA31; 70 V32 : A_UA32; 71 72 BEGIN 73 74 BEGIN -- V11 75 76 V11 := NEW CA11; 77 FAILED("NO EXCEPTION RAISED - V11"); 78 79 EXCEPTION 80 81 WHEN CONSTRAINT_ERROR => 82 NULL; 83 WHEN OTHERS => 84 FAILED("WRONG EXCEPTION RAISED - V11"); 85 86 END; 87 88 BEGIN -- V12 89 90 V12 := NEW CA12; 91 FAILED("NO EXCEPTION RAISED - V12"); 92 93 EXCEPTION 94 95 WHEN CONSTRAINT_ERROR => 96 NULL; 97 WHEN OTHERS => 98 FAILED("WRONG EXCEPTION RAISED - V12"); 99 100 END; 101 102 BEGIN -- V21 103 104 V21 := NEW CA21; 105 FAILED("NO EXCEPTION RAISED - V21"); 106 107 EXCEPTION 108 109 WHEN CONSTRAINT_ERROR => 110 NULL; 111 WHEN OTHERS => 112 FAILED("WRONG EXCEPTION RAISED - V21"); 113 114 END; 115 116 BEGIN -- V22 117 118 V22 := NEW CA22; 119 FAILED("NO EXCEPTION RAISED - V22"); 120 121 EXCEPTION 122 123 WHEN CONSTRAINT_ERROR => 124 NULL; 125 WHEN OTHERS => 126 FAILED("WRONG EXCEPTION RAISED - V22"); 127 128 END; 129 130 BEGIN -- V31 131 132 V31 := NEW CA31; 133 FAILED("NO EXCEPTION RAISED - V31"); 134 135 EXCEPTION 136 137 WHEN CONSTRAINT_ERROR => 138 NULL; 139 WHEN OTHERS => 140 FAILED("WRONG EXCEPTION RAISED - V31"); 141 142 END; 143 144 BEGIN -- V32 145 146 V32 := NEW CA32; 147 FAILED("NO EXCEPTION RAISED - V32"); 148 149 EXCEPTION 150 151 WHEN CONSTRAINT_ERROR => 152 NULL; 153 WHEN OTHERS => 154 FAILED("WRONG EXCEPTION RAISED - V32"); 155 156 END; 157 158 END; 159 160 RESULT; 161 162END C48007C; 163