1-- C36301A.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 PREDEFINED POSITIVE AND STRING TYPES 26-- ARE CORRECTLY DEFINED. 27 28-- DAT 2/17/81 29-- JBG 12/27/82 30-- RJW 1/20/86 - CHANGED 'NATURAL' TO 'POSITIVE'. ADDED ADDITIONAL 31-- CASES, INCLUDING A CHECK FOR STRINGS WITH BOUNDS 32-- OF INTEGER'FIRST AND INTEGER'LAST. 33-- EDS 7/16/98 AVOID OPTIMIZATION 34 35WITH REPORT; USE REPORT; 36 37PROCEDURE C36301A IS 38 39BEGIN 40 TEST ( "C36301A", "CHECK ATTRIBUTES OF PREDEFINED POSITIVE " & 41 "AND STRING" ); 42 43 BEGIN 44 IF POSITIVE'FIRST /= 1 THEN 45 FAILED ( "POSITIVE'FIRST IS WRONG" ); 46 END IF; 47 48 IF POSITIVE'LAST /= INTEGER'LAST THEN 49 FAILED ( "POSITIVE'LAST IS WRONG" ); 50 END IF; 51 END; 52 53 DECLARE 54 55 C : STRING (1..2) := ( 'A', 'B' ); 56 57 BEGIN 58 IF C'LENGTH /= 2 THEN 59 FAILED ( "LENGTH OF C IS WRONG" ); 60 END IF; 61 62 IF C'FIRST /= 1 THEN 63 FAILED ( "C'FIRST IS WRONG" ); 64 END IF; 65 66 IF C'LAST /= 2 THEN 67 FAILED ( "C'LAST IS WRONG" ); 68 END IF; 69 END; 70 71 DECLARE 72 73 SUBTYPE LARGE IS STRING ( INTEGER'LAST - 3 .. INTEGER'LAST ); 74 75 BEGIN 76 IF LARGE'LENGTH /= 4 THEN 77 FAILED ( "LENGTH OF LARGE IS WRONG" ); 78 END IF; 79 80 IF LARGE'FIRST /= INTEGER'LAST - 3 THEN 81 FAILED ( "LARGE'FIRST IS WRONG" ); 82 END IF; 83 84 IF LARGE'LAST /= INTEGER'LAST THEN 85 FAILED ( "LARGE'LAST IS WRONG" ); 86 END IF; 87 END; 88 89 DECLARE 90 91 SUBTYPE LARGER IS STRING ( 1 .. INTEGER'LAST ); 92 93 BEGIN 94 IF LARGER'LENGTH /= INTEGER'LAST THEN 95 FAILED ( "LENGTH OF LARGER IS WRONG" ); 96 END IF; 97 98 IF LARGER'FIRST /= 1 THEN 99 FAILED ( "LARGER'FIRST IS WRONG" ); 100 END IF; 101 102 IF LARGER'LAST /= INTEGER'LAST THEN 103 FAILED ( "LARGER'LAST IS WRONG" ); 104 END IF; 105 END; 106 107 BEGIN 108 DECLARE 109 110 D : STRING ( INTEGER'FIRST .. INTEGER'FIRST + 3 ); 111 112 BEGIN 113 IF D'FIRST /= INTEGER'FIRST THEN -- USE D 114 FAILED ("D'FIRST IS INCORRECT " & INTEGER'IMAGE(D'FIRST)); 115 END IF; 116 FAILED ( "NO EXCEPTION RAISED" ); 117 END; 118 EXCEPTION 119 WHEN CONSTRAINT_ERROR => 120 NULL; 121 WHEN OTHERS => 122 FAILED ( "WRONG EXCEPTION RAISED" ); 123 END; 124 125 BEGIN 126 DECLARE 127 128 E : STRING ( -1 .. INTEGER'FIRST ); 129 130 BEGIN 131 IF E'LENGTH /= 0 THEN 132 FAILED ( "LENGTH OF E IS WRONG" ); 133 END IF; 134 135 IF E'FIRST /= -1 THEN 136 FAILED ( "E'FIRST IS WRONG" ); 137 END IF; 138 139 IF E'LAST /= INTEGER'FIRST THEN 140 FAILED ( "E'LAST IS WRONG" ); 141 END IF; 142 END; 143 EXCEPTION 144 WHEN OTHERS => 145 FAILED ( "EXCEPTION RAISED FOR NULL STRING" ); 146 END; 147 148 RESULT; 149END C36301A; 150