1-- C35505F.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 RAISED BY THE ATTRIBUTES 27-- 'PRED' AND 'SUCC' WHEN THE PREFIX IS A CHARACTER TYPE 28-- AND THE RESULT IS OUTSIDE OF THE BASE TYPE. 29 30-- HISTORY: 31-- JET 08/18/87 CREATED ORIGINAL TEST. 32 33WITH REPORT; USE REPORT; 34 35PROCEDURE C35505F IS 36 37 TYPE CHAR IS ('A', B); 38 39 TYPE NEWCHAR IS NEW CHAR; 40 41 FUNCTION IDENT (CH : CHAR) RETURN CHAR IS 42 BEGIN 43 RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH))); 44 END; 45 46 FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS 47 BEGIN 48 RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH))); 49 END; 50 51BEGIN 52 53 TEST( "C35505F" , "CHECK THAT CONSTRAINT ERROR IS RAISED BY " & 54 "THE ATTRIBUTES 'PRED' AND 'SUCC' WHEN THE " & 55 "PREFIX IS A CHARACTER TYPE AND THE RESULT " & 56 "IS OUTSIDE OF THE BASE TYPE" ); 57 58 BEGIN 59 IF CHAR'PRED (IDENT ('A')) = 'A' THEN 60 FAILED ( "NO EXCEPTION RAISED " & 61 "FOR CHAR'PRED (IDENT ('A')) - 1" ); 62 ELSE 63 FAILED ( "NO EXCEPTION RAISED " & 64 "FOR CHAR'PRED (IDENT ('A')) - 2" ); 65 END IF; 66 EXCEPTION 67 WHEN CONSTRAINT_ERROR => 68 NULL; 69 WHEN OTHERS => 70 FAILED ( "WRONG EXCEPTION RAISED " & 71 "FOR CHAR'PRED (IDENT ('A'))" ); 72 END; 73 74 BEGIN 75 IF CHAR'SUCC (IDENT (B)) = B THEN 76 FAILED ( "NO EXCEPTION RAISED " & 77 "FOR CHAR'SUCC (IDENT (B)) - 1" ); 78 ELSE 79 FAILED ( "NO EXCEPTION RAISED " & 80 "FOR CHAR'SUCC (IDENT (B)) - 2" ); 81 END IF; 82 EXCEPTION 83 WHEN CONSTRAINT_ERROR => 84 NULL; 85 WHEN OTHERS => 86 FAILED ( "WRONG EXCEPTION RAISED " & 87 "FOR CHAR'SUCC (IDENT (B))" ); 88 END; 89 90 BEGIN 91 IF NEWCHAR'PRED (IDENT ('A')) = 'A' THEN 92 FAILED ( "NO EXCEPTION RAISED " & 93 "FOR NEWCHAR'PRED (IDENT ('A')) - 1" ); 94 ELSE 95 FAILED ( "NO EXCEPTION RAISED " & 96 "FOR NEWCHAR'PRED (IDENT ('A')) - 2" ); 97 END IF; 98 EXCEPTION 99 WHEN CONSTRAINT_ERROR => 100 NULL; 101 WHEN OTHERS => 102 FAILED ( "WRONG EXCEPTION RAISED " & 103 "FOR NEWCHAR'PRED (IDENT ('A'))" ); 104 END; 105 106 BEGIN 107 IF NEWCHAR'SUCC (IDENT (B)) = 'A' THEN 108 FAILED ( "NO EXCEPTION RAISED " & 109 "FOR NEWCHAR'SUCC (IDENT (B)) - 1" ); 110 ELSE 111 FAILED ( "NO EXCEPTION RAISED " & 112 "FOR NEWCHAR'SUCC (IDENT (B)) - 2" ); 113 END IF; 114 EXCEPTION 115 WHEN CONSTRAINT_ERROR => 116 NULL; 117 WHEN OTHERS => 118 FAILED ( "WRONG EXCEPTION RAISED " & 119 "FOR NEWCHAR'SUCC (IDENT (B))" ); 120 END; 121 122 BEGIN 123 IF CHARACTER'PRED (IDENT_CHAR (CHARACTER'BASE'FIRST)) = 'A' 124 THEN 125 FAILED ( "NO EXCEPTION RAISED " & 126 "FOR CHARACTER'PRED " & 127 "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 1" ); 128 ELSE 129 FAILED ( "NO EXCEPTION RAISED " & 130 "FOR CHARACTER'PRED " & 131 "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 2" ); 132 END IF; 133 EXCEPTION 134 WHEN CONSTRAINT_ERROR => 135 NULL; 136 WHEN OTHERS => 137 FAILED ( "WRONG EXCEPTION RAISED " & 138 "FOR CHARACTER'PRED " & 139 "(IDENT_CHAR (CHARACTER'BASE'FIRST))" ); 140 END; 141 142 BEGIN 143 IF CHARACTER'SUCC (IDENT_CHAR (CHARACTER'BASE'LAST)) = 'Z' 144 THEN 145 FAILED ( "NO EXCEPTION RAISED " & 146 "FOR CHARACTER'SUCC " & 147 "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 1" ); 148 ELSE 149 FAILED ( "NO EXCEPTION RAISED " & 150 "FOR CHARACTER'SUCC " & 151 "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 2" ); 152 END IF; 153 EXCEPTION 154 WHEN CONSTRAINT_ERROR => 155 NULL; 156 WHEN OTHERS => 157 FAILED ( "WRONG EXCEPTION RAISED " & 158 "FOR CHARACTER'SUCC " & 159 "(IDENT_CHAR (CHARACTER'BASE'LAST))" ); 160 END; 161 162 RESULT; 163 164END C35505F; 165