1-- C41402A.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 NOT RAISED IF THE PREFIX OF 27-- 'ADDRESS, 'SIZE, 'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE 28-- VALUE NULL. 29 30-- HISTORY: 31-- TBN 10/02/86 CREATED ORIGINAL TEST. 32-- CJJ 07/01/87 REMOVED TEST FOR 'STORAGE_SIZE, WHICH IS NO LONGER 33-- PART OF THE OBJECTIVE. 34 35WITH SYSTEM; USE SYSTEM; 36WITH REPORT; USE REPORT; 37PROCEDURE C41402A IS 38 39 TYPE ARRAY1 IS ARRAY (1 .. 2) OF INTEGER; 40 TYPE ACC_ARA IS ACCESS ARRAY1; 41 42 PTR_ARA : ACC_ARA; 43 VAR1 : INTEGER; 44 45 TYPE REC1 IS 46 RECORD 47 A : INTEGER; 48 END RECORD; 49 50 TYPE ACC_REC1 IS ACCESS REC1; 51 52 TYPE REC2 IS 53 RECORD 54 P_AR : ACC_ARA; 55 P_REC : ACC_REC1; 56 END RECORD; 57 58 OBJ_REC : REC2; 59 60 61 PROCEDURE PROC (A : ADDRESS) IS 62 BEGIN 63 NULL; 64 END; 65 66BEGIN 67 TEST ("C41402A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " & 68 "THE PREFIX OF 'ADDRESS, 'SIZE, " & 69 "'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE " & 70 "VALUE NULL"); 71 72 BEGIN 73 PROC (PTR_ARA'ADDRESS); 74 EXCEPTION 75 WHEN CONSTRAINT_ERROR => 76 FAILED ("CONSTRAINT_ERROR RAISED FOR 'ADDRESS"); 77 WHEN OTHERS => 78 FAILED ("UNEXPECTED EXCEPTION RAISED 'ADDRESS"); 79 END; 80 81 BEGIN 82 VAR1 := PTR_ARA'SIZE; 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => 85 FAILED ("CONSTRAINT_ERROR RAISED FOR 'SIZE"); 86 WHEN OTHERS => 87 FAILED ("UNEXPECTED EXCEPTION RAISED 'SIZE"); 88 END; 89 90 BEGIN 91 VAR1 := OBJ_REC.P_AR'FIRST_BIT; 92 EXCEPTION 93 WHEN CONSTRAINT_ERROR => 94 FAILED ("CONSTRAINT_ERROR RAISED FOR 'FIRST_BIT"); 95 WHEN OTHERS => 96 FAILED ("UNEXPECTED EXCEPTION RAISED 'FIRST_BIT"); 97 END; 98 99 BEGIN 100 VAR1 := OBJ_REC.P_AR'LAST_BIT; 101 EXCEPTION 102 WHEN CONSTRAINT_ERROR => 103 FAILED ("CONSTRAINT_ERROR RAISED FOR 'LAST_BIT"); 104 WHEN OTHERS => 105 FAILED ("UNEXPECTED EXCEPTION RAISED 'LAST_BIT"); 106 END; 107 108 BEGIN 109 VAR1 := OBJ_REC.P_REC'POSITION; 110 EXCEPTION 111 WHEN CONSTRAINT_ERROR => 112 FAILED ("CONSTRAINT_ERROR RAISED FOR 'POSITION"); 113 WHEN OTHERS => 114 FAILED ("UNEXPECTED EXCEPTION RAISED 'POSITION"); 115 END; 116 117 RESULT; 118END C41402A; 119