1-- C35502N.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN 27-- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS 28-- AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE, 29-- WITH AN ENUMERATION REPRESENTATION CLAUSE. 30 31-- HISTORY: 32-- RJW 05/27/86 33-- DWC 07/22/87 ADDED THE PARAMETER 'N' TO FUNCTION F. 34-- PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'. 35 36WITH REPORT; USE REPORT; 37 38PROCEDURE C35502N IS 39 40 TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD); 41 FOR ENUM USE (A => 1, BC => 4, ABC => 5, A_B_C => 6, 42 ABCD => 8); 43 44 SUBTYPE SUBENUM IS ENUM RANGE A .. BC; 45 46 TYPE NEWENUM IS NEW ENUM; 47 SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC; 48 49BEGIN 50 TEST ("C35502N", "CHECK THAT 'POS' AND 'VAL' YIELD THE " & 51 "CORRECT RESULTS WHEN THE PREFIX IS A " & 52 "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " & 53 "IS AN ENUMERATION TYPE, OTHER THAN A " & 54 "CHARACTER OR A BOOLEAN TYPE, WITH AN " & 55 "ENUMERATION REPRESENTATION CLAUSE" ); 56 57 DECLARE 58 59 GENERIC 60 TYPE E IS (<>); 61 STR : STRING; 62 PROCEDURE P; 63 64 PROCEDURE P IS 65 SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1); 66 POSITION : INTEGER; 67 BEGIN 68 69 POSITION := 0; 70 71 FOR E1 IN E LOOP 72 IF SE'POS (E1) /= POSITION THEN 73 FAILED ( "INCORRECT " & STR & "'POS (" & 74 E'IMAGE (E1) & ")" ); 75 END IF; 76 77 IF SE'VAL (POSITION) /= E1 THEN 78 FAILED ( "INCORRECT " & STR & "'VAL (" & 79 INTEGER'IMAGE (POSITION) & 80 ")" ); 81 END IF; 82 83 POSITION := POSITION + 1; 84 END LOOP; 85 86 BEGIN 87 IF E'VAL (-1) = E'VAL (1) THEN 88 FAILED ( "NO EXCEPTION RAISED FOR " & 89 STR & "'VAL (-1) - 1" ); 90 ELSE 91 FAILED ( "NO EXCEPTION RAISED FOR " & 92 STR & "'VAL (-1) - 2" ); 93 END IF; 94 EXCEPTION 95 WHEN CONSTRAINT_ERROR => 96 NULL; 97 WHEN OTHERS => 98 FAILED ( "WRONG EXCEPTION RAISED FOR " & 99 STR & "'VAL (-1)" ); 100 END; 101 102 BEGIN 103 IF E'VAL (5) = E'VAL (4) THEN 104 FAILED ( "NO EXCEPTION RAISED FOR " & 105 STR & "'VAL (5) - 1" ); 106 ELSE 107 FAILED ( "NO EXCEPTION RAISED FOR " & 108 STR & "'VAL (5) - 2" ); 109 END IF; 110 EXCEPTION 111 WHEN CONSTRAINT_ERROR => 112 NULL; 113 WHEN OTHERS => 114 FAILED ( "WRONG EXCEPTION RAISED FOR " & 115 STR & "'VAL (5)" ); 116 END; 117 END P; 118 119 PROCEDURE PE IS NEW P ( ENUM, "ENUM" ); 120 PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" ); 121 BEGIN 122 PE; 123 PN; 124 END; 125 126 DECLARE 127 FUNCTION A_B_C RETURN ENUM IS 128 BEGIN 129 RETURN ENUM'VAL (IDENT_INT (0)); 130 END A_B_C; 131 132 GENERIC 133 TYPE E IS (<>); 134 FUNCTION F (N : INTEGER; 135 E1 : E) RETURN BOOLEAN; 136 137 FUNCTION F (N : INTEGER; 138 E1 : E) RETURN BOOLEAN IS 139 BEGIN 140 RETURN E'VAL (N) = E1; 141 END F; 142 143 FUNCTION FE IS NEW F (ENUM); 144 145 BEGIN 146 147 IF NOT FE (0, A_B_C) THEN 148 FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " & 149 "BY A FUNCTION" ); 150 END IF; 151 152 IF NOT FE (3, C35502N.A_B_C) THEN 153 FAILED ( "INCORRECT VAL FOR C35502N.A_B_C" ); 154 END IF; 155 END; 156 157 RESULT; 158END C35502N; 159