1-- C43212C.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 IF ALL SUBAGGREGATES FOR 26-- A PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS. 27-- ADDITIONAL CASES FOR THE THIRD DIMENSION AND FOR THE NULL ARRAYS. 28 29-- PK 02/21/84 30-- EG 05/30/84 31 32WITH REPORT; 33USE REPORT; 34 35PROCEDURE C43212C IS 36 37 SUBTYPE INT IS INTEGER RANGE 1 .. 3; 38 39BEGIN 40 41 TEST("C43212C","CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " & 42 "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO " & 43 "NOT HAVE THE SAME BOUNDS"); 44 45 DECLARE 46 TYPE A3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>) 47 OF INTEGER; 48 BEGIN 49 IF A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)), 50 (1 .. IDENT_INT(2) => IDENT_INT(1))), 51 ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)), 52 (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 53 = 54 A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)), 55 (1 .. IDENT_INT(2) => IDENT_INT(1))), 56 ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)), 57 (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 58 THEN 59 FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS EQUAL"); 60 END IF; 61 FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL"); 62 63 EXCEPTION 64 65 WHEN CONSTRAINT_ERROR => NULL; 66 WHEN OTHERS => 67 FAILED ("A3 - WRONG EXCEPTION RAISED"); 68 69 END; 70 71 DECLARE 72 73 TYPE B3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>) 74 OF INTEGER; 75 76 BEGIN 77 78 IF B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)), 79 (2 .. IDENT_INT(1) => IDENT_INT(1))), 80 ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)), 81 (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 82 = 83 B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)), 84 (2 .. IDENT_INT(1) => IDENT_INT(1))), 85 ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)), 86 (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 87 THEN 88 FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS EQUAL"); 89 END IF; 90 FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL"); 91 92 EXCEPTION 93 94 WHEN CONSTRAINT_ERROR => NULL; 95 WHEN OTHERS => 96 FAILED ("B3 - WRONG EXCEPTION RAISED"); 97 98 END; 99 100 RESULT; 101 102END C43212C; 103