1-- C35703A.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 'FIRST AND 'LAST EXIST AND CAN BE ASSIGNED. CHECK THAT 26-- 'FIRST IS LESS THAN OR EQUAL TO 'LAST. 27 28-- BAW 5 SEPT 80 29-- R.WILLIAMS 8/21/86 ADDED A TYPE DECLARED WITHOUT A RANGE 30-- CONSTRAINT. RENAMED TO -B. ADDED EXCEPTION 31-- HANDLERS. 32-- GMT 6/29/87 MOVED THE CALL TO REPORT.TEST INTO A NEWLY 33-- CREATED PACKAGE NAMED SHOW_TEST_HEADER. 34 35 36WITH REPORT; USE REPORT; 37PROCEDURE C35703A IS 38 39 TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5; 40 TYPE REAL2 IS DIGITS 3; 41 42 PACKAGE SHOW_TEST_HEADER IS 43 -- PURPOSE OF THIS PACKAGE: 44 -- WE WANT THE TEST HEADER INFORMATION TO BE 45 -- PRINTED BEFORE ANY OF THE PASS/FAIL MESSAGES. 46 END SHOW_TEST_HEADER; 47 48 PACKAGE BODY SHOW_TEST_HEADER IS 49 BEGIN 50 TEST( "C35703A", 51 "CHECK THAT FIRST AND LAST CAN BE ASSIGNED " & 52 "AND THAT FIRST <= LAST" ); 53 END SHOW_TEST_HEADER; 54 55 PACKAGE XPKG IS 56 X : REAL1; 57 END XPKG; 58 59 PACKAGE BODY XPKG IS 60 BEGIN 61 X := REAL1'FIRST; 62 EXCEPTION 63 WHEN CONSTRAINT_ERROR => 64 FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " & 65 "REAL1'FIRST" ); 66 WHEN OTHERS => 67 FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " & 68 "REAL1'FIRST" ); 69 END XPKG; 70 71 PACKAGE YPKG IS 72 Y : REAL1; 73 END YPKG; 74 75 PACKAGE BODY YPKG IS 76 BEGIN 77 Y := REAL1'LAST; 78 EXCEPTION 79 WHEN CONSTRAINT_ERROR => 80 FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " & 81 "REAL1'LAST" ); 82 WHEN OTHERS => 83 FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " & 84 "REAL1'LAST" ); 85 END YPKG; 86 87 PACKAGE APKG IS 88 A : REAL2; 89 END APKG; 90 91 PACKAGE BODY APKG IS 92 BEGIN 93 A := REAL2'FIRST; 94 EXCEPTION 95 WHEN CONSTRAINT_ERROR => 96 FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " & 97 "REAL2'FIRST" ); 98 WHEN OTHERS => 99 FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " & 100 "REAL2'FIRST" ); 101 END APKG; 102 103 PACKAGE BPKG IS 104 B : REAL2; 105 END BPKG; 106 107 PACKAGE BODY BPKG IS 108 BEGIN 109 B := REAL2'LAST; 110 EXCEPTION 111 WHEN CONSTRAINT_ERROR => 112 FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " & 113 "REAL2'LAST" ); 114 WHEN OTHERS => 115 FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " & 116 "REAL2'LAST" ); 117 END BPKG; 118 119 120BEGIN 121 122 DECLARE 123 USE XPKG; 124 USE YPKG; 125 BEGIN 126 IF X > Y THEN 127 FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" ); 128 END IF; 129 END; 130 131 DECLARE 132 USE APKG; 133 USE BPKG; 134 BEGIN 135 IF A > B THEN 136 FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" ); 137 END IF; 138 END; 139 140 RESULT; 141 142END C35703A; 143