-- C47009B.ADA -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- OBJECTIVE: -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS -- TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE -- OF THE OPERAND IS NULL. -- HISTORY: -- RJW 07/23/86 CREATED ORIGINAL TEST. -- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. CHANGED -- CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE -- CLOSER TO THE VALUES OF THE A SUBTYPES. INDENTED -- THE EXCEPTION STATEMENTS IN SUBTEST 11. WITH REPORT; USE REPORT; PROCEDURE C47009B IS BEGIN TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " & "EXPRESSION DENOTES AN ACCESS TYPE, " & "CHECK THAT CONSTRAINT_ERROR IS NOT " & "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" ); DECLARE TYPE ACC1 IS ACCESS BOOLEAN; A : ACC1; BEGIN A := ACC1'(NULL); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" ); END; DECLARE TYPE ACC2 IS ACCESS INTEGER; A : ACC2; BEGIN A := ACC2'(NULL); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" ); END; DECLARE TYPE CHAR IS ('A', 'B'); TYPE ACC3 IS ACCESS CHAR; A : ACC3; BEGIN A := ACC3'(NULL); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" ); END; DECLARE TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0; TYPE ACC4 IS ACCESS FLOAT1; A : ACC4; BEGIN A := ACC4'(NULL); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" ); END; DECLARE TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0; TYPE ACC5 IS ACCESS FIXED; A : ACC5; BEGIN A := ACC5'(NULL); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" ); END; DECLARE TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; TYPE ACC6 IS ACCESS ARR; SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5)); SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10)); A : ACC6A; B : ACC6B; BEGIN A := ACC6A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & "TYPE ACC6" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC6" ); END; DECLARE TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF INTEGER; TYPE ACC7 IS ACCESS ARR; SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5), IDENT_INT (1) .. IDENT_INT (1)); SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15), IDENT_INT (1) .. IDENT_INT (10)); A : ACC7A; B : ACC7B; BEGIN A := ACC7A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & "TYPE ACC7" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC7" ); END; DECLARE TYPE REC (D : INTEGER) IS RECORD NULL; END RECORD; TYPE ACC8 IS ACCESS REC; SUBTYPE ACC8A IS ACC8 (IDENT_INT (5)); SUBTYPE ACC8B IS ACC8 (IDENT_INT (6)); A : ACC8A; B : ACC8B; BEGIN A := ACC8A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & "TYPE ACC8" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC8" ); END; DECLARE TYPE REC (D1,D2 : INTEGER) IS RECORD NULL; END RECORD; TYPE ACC9 IS ACCESS REC; SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5)); SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4)); A : ACC9A; B : ACC9B; BEGIN A := ACC9A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & "TYPE ACC9" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC9" ); END; DECLARE PACKAGE PKG IS TYPE REC (D : INTEGER) IS PRIVATE; PRIVATE TYPE REC (D : INTEGER) IS RECORD NULL; END RECORD; END PKG; USE PKG; TYPE ACC10 IS ACCESS REC; SUBTYPE ACC10A IS ACC10 (IDENT_INT (10)); SUBTYPE ACC10B IS ACC10 (IDENT_INT (9)); A : ACC10A; B : ACC10B; BEGIN A := ACC10A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & "TYPE ACC10" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC10" ); END; DECLARE PACKAGE PKG1 IS TYPE REC (D : INTEGER) IS LIMITED PRIVATE; PRIVATE TYPE REC (D : INTEGER) IS RECORD NULL; END RECORD; END PKG1; PACKAGE PKG2 IS END PKG2; PACKAGE BODY PKG2 IS USE PKG1; TYPE ACC11 IS ACCESS REC; SUBTYPE ACC11A IS ACC11 (IDENT_INT (11)); SUBTYPE ACC11B IS ACC11 (IDENT_INT (12)); A : ACC11A; B : ACC11B; BEGIN A := ACC11A'(B); EXCEPTION WHEN CONSTRAINT_ERROR => FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" & " TYPE ACC11" ); WHEN OTHERS => FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & "TYPE ACC11" ); END PKG2; BEGIN NULL; END; RESULT; END C47009B;