| -- C45112B.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. |
| --* |
| -- CHECK THAT THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION |
| -- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL |
| -- ARRAYS. |
| |
| -- RJW 2/3/86 |
| |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C45112B IS |
| |
| TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN; |
| A1 : ARR(IDENT_INT(4) .. IDENT_INT(3)); |
| A2 : ARR(IDENT_INT(2) .. IDENT_INT(1)); |
| SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST)); |
| |
| PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS |
| BEGIN |
| IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN |
| FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 ); |
| END IF; |
| END CHECK; |
| |
| BEGIN |
| |
| TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " & |
| "ARRAY OPERATIONS ON NULL ARRAYS" ); |
| |
| BEGIN |
| DECLARE |
| AAND : CONSTANT ARR := A1 AND A2; |
| AOR : CONSTANT ARR := A1 OR A2; |
| AXOR : CONSTANT ARR := A1 XOR A2; |
| BEGIN |
| CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", |
| "'AND'" ); |
| |
| CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", |
| "'OR'" ); |
| |
| CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", |
| "'XOR'" ); |
| END; |
| EXCEPTION |
| WHEN CONSTRAINT_ERROR => |
| FAILED ( "CONSTRAINT_ERROR RAISED DURING " & |
| "INTIALIZATIONS" ); |
| WHEN OTHERS => |
| FAILED ( "OTHER EXCEPTION RAISED DURING " & |
| "INITIALIZATIONS" ); |
| END; |
| |
| DECLARE |
| PROCEDURE PROC (A : ARR; STR : STRING) IS |
| BEGIN |
| CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", |
| STR); |
| END PROC; |
| BEGIN |
| PROC ((A1 AND A2), "'AND'" ); |
| PROC ((A1 OR A2), "'OR'" ); |
| PROC ((A1 XOR A2), "'XOR'" ); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " & |
| "PARAMETERS" ); |
| END; |
| |
| DECLARE |
| FUNCTION FUNCAND RETURN ARR IS |
| BEGIN |
| RETURN A1 AND A2; |
| END FUNCAND; |
| |
| FUNCTION FUNCOR RETURN ARR IS |
| BEGIN |
| RETURN A1 OR A2; |
| END FUNCOR; |
| |
| FUNCTION FUNCXOR RETURN ARR IS |
| BEGIN |
| RETURN A1 XOR A2; |
| END FUNCXOR; |
| |
| BEGIN |
| CHECK (FUNCAND, "RETURN STATEMENT", "'AND'"); |
| CHECK (FUNCOR, "RETURN STATEMENT", "'OR'"); |
| CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'"); |
| |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " & |
| "FROM FUNCTION" ); |
| END; |
| |
| BEGIN |
| DECLARE |
| GENERIC |
| X : IN ARR; |
| PACKAGE PKG IS |
| FUNCTION G RETURN ARR; |
| END PKG; |
| |
| PACKAGE BODY PKG IS |
| FUNCTION G RETURN ARR IS |
| BEGIN |
| RETURN X; |
| END G; |
| END PKG; |
| |
| PACKAGE PAND IS NEW PKG(X => A1 AND A2); |
| PACKAGE POR IS NEW PKG(X => A1 OR A2); |
| PACKAGE PXOR IS NEW PKG(X => A1 XOR A2); |
| BEGIN |
| CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'"); |
| CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'"); |
| CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'"); |
| END; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING GENERIC " & |
| "INSTANTIATION" ); |
| END; |
| |
| DECLARE |
| TYPE ACC IS ACCESS ARR; |
| AC : ACC; |
| |
| BEGIN |
| AC := NEW ARR'(A1 AND A2); |
| CHECK (AC.ALL, "ALLOCATION", "'AND'"); |
| AC := NEW ARR'(A1 OR A2); |
| CHECK (AC.ALL, "ALLOCATION", "'OR'"); |
| AC := NEW ARR'(A1 XOR A2); |
| CHECK (AC.ALL, "ALLOCATION", "'XOR'"); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED ON ALLOCATION" ); |
| END; |
| |
| BEGIN |
| CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'"); |
| CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'"); |
| CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'"); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" ); |
| END; |
| |
| DECLARE |
| TYPE REC IS |
| RECORD |
| RCA : CARR; |
| END RECORD; |
| R1 : REC; |
| |
| BEGIN |
| R1 := (RCA => (A1 AND A2)); |
| CHECK (R1.RCA, "AGGREGATE", "'AND'"); |
| R1 := (RCA => (A1 OR A2)); |
| CHECK (R1.RCA, "AGGREGATE", "'OR'"); |
| R1 := (RCA => (A1 XOR A2)); |
| CHECK (R1.RCA, "AGGREGATE", "'XOR'"); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED ON AGGREGATE" ); |
| END; |
| |
| BEGIN |
| DECLARE |
| TYPE RECDEF IS |
| RECORD |
| RCDF1 : CARR := A1 AND A2; |
| RCDF2 : CARR := A1 OR A2; |
| RCDF3 : CARR := A1 XOR A2; |
| END RECORD; |
| RD : RECDEF; |
| BEGIN |
| CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'"); |
| CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'"); |
| CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'"); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" ); |
| END; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " & |
| "DEFAULT RECORD" ); |
| END; |
| |
| DECLARE |
| PROCEDURE PDEF (X : CARR := A1 AND A2; |
| Y : CARR := A1 OR A2; |
| Z : CARR := A1 XOR A2 ) IS |
| BEGIN |
| CHECK (X, "DEFAULT PARAMETER", "'AND'"); |
| CHECK (Y, "DEFAULT PARAMETER", "'OR'"); |
| CHECK (Z, "DEFAULT PARAMETER", "'XOR'"); |
| END PDEF; |
| |
| BEGIN |
| PDEF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" ); |
| END; |
| |
| RESULT; |
| |
| END C45112B; |