| -- C46051A.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 ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN |
| -- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY |
| -- DERIVATION. |
| |
| -- R.WILLIAMS 9/8/86 |
| |
| WITH REPORT; USE REPORT; |
| PROCEDURE C46051A IS |
| |
| BEGIN |
| TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " & |
| "PRIVATE, AND TASK VALUES CAN BE CONVERTED " & |
| "IF THE OPERAND AND TARGET TYPES ARE " & |
| "RELATED BY DERIVATION" ); |
| |
| DECLARE |
| TYPE ENUM IS (A, AB, ABC, ABCD); |
| E : ENUM := ABC; |
| |
| TYPE ENUM1 IS NEW ENUM; |
| E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2)); |
| |
| TYPE ENUM2 IS NEW ENUM; |
| E2 : ENUM2 := ABC; |
| |
| TYPE NENUM1 IS NEW ENUM1; |
| NE : NENUM1 := NENUM1'VAL (IDENT_INT (2)); |
| BEGIN |
| IF ENUM (E) /= E THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" ); |
| END IF; |
| |
| IF ENUM (E1) /= E THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" ); |
| END IF; |
| |
| IF ENUM1 (E2) /= E1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" ); |
| END IF; |
| |
| IF ENUM2 (NE) /= E2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" ); |
| END IF; |
| |
| IF NENUM1 (E) /= NE THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "ENUMERATION TYPES" ); |
| END; |
| |
| DECLARE |
| TYPE REC IS |
| RECORD |
| NULL; |
| END RECORD; |
| |
| R : REC; |
| |
| TYPE REC1 IS NEW REC; |
| R1 : REC1; |
| |
| TYPE REC2 IS NEW REC; |
| R2 : REC2; |
| |
| TYPE NREC1 IS NEW REC1; |
| NR : NREC1; |
| BEGIN |
| IF REC (R) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" ); |
| END IF; |
| |
| IF REC (R1) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" ); |
| END IF; |
| |
| IF REC1 (R2) /= R1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" ); |
| END IF; |
| |
| IF REC2 (NR) /= R2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" ); |
| END IF; |
| |
| IF NREC1 (R) /= NR THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "RECORD TYPES" ); |
| END; |
| |
| DECLARE |
| TYPE REC (D : INTEGER) IS |
| RECORD |
| NULL; |
| END RECORD; |
| |
| SUBTYPE CREC IS REC (3); |
| R : CREC; |
| |
| TYPE CREC1 IS NEW REC (3); |
| R1 : CREC1; |
| |
| TYPE CREC2 IS NEW REC (3); |
| R2 : CREC2; |
| |
| TYPE NCREC1 IS NEW CREC1; |
| NR : NCREC1; |
| BEGIN |
| IF CREC (R) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" ); |
| END IF; |
| |
| IF CREC (R1) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" ); |
| END IF; |
| |
| IF CREC1 (R2) /= R1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" ); |
| END IF; |
| |
| IF CREC2 (NR) /= R2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" ); |
| END IF; |
| |
| IF NCREC1 (R) /= NR THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "RECORD TYPES WITH DISCRIMINANTS" ); |
| END; |
| |
| DECLARE |
| TYPE REC IS |
| RECORD |
| NULL; |
| END RECORD; |
| |
| TYPE ACCREC IS ACCESS REC; |
| AR : ACCREC; |
| |
| TYPE ACCREC1 IS NEW ACCREC; |
| AR1 : ACCREC1; |
| |
| TYPE ACCREC2 IS NEW ACCREC; |
| AR2 : ACCREC2; |
| |
| TYPE NACCREC1 IS NEW ACCREC1; |
| NAR : NACCREC1; |
| |
| FUNCTION F (A : ACCREC) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (0); |
| END F; |
| |
| FUNCTION F (A : ACCREC1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (1); |
| END F; |
| |
| FUNCTION F (A : ACCREC2) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (2); |
| END F; |
| |
| FUNCTION F (A : NACCREC1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (3); |
| END F; |
| |
| BEGIN |
| IF F (ACCREC (AR)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" ); |
| END IF; |
| |
| IF F (ACCREC (AR1)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" ); |
| END IF; |
| |
| IF F (ACCREC1 (AR2)) /= 1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" ); |
| END IF; |
| |
| IF F (ACCREC2 (NAR)) /= 2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" ); |
| END IF; |
| |
| IF F (NACCREC1 (AR)) /= 3 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "ACCESS TYPES" ); |
| END; |
| |
| DECLARE |
| TYPE REC (D : INTEGER) IS |
| RECORD |
| NULL; |
| END RECORD; |
| |
| TYPE ACCR IS ACCESS REC; |
| |
| SUBTYPE CACCR IS ACCR (3); |
| AR : CACCR; |
| |
| TYPE CACCR1 IS NEW ACCR (3); |
| AR1 : CACCR1; |
| |
| TYPE CACCR2 IS NEW ACCR (3); |
| AR2 : CACCR2; |
| |
| TYPE NCACCR1 IS NEW CACCR1; |
| NAR : NCACCR1; |
| |
| FUNCTION F (A : CACCR) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (0); |
| END F; |
| |
| FUNCTION F (A : CACCR1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (1); |
| END F; |
| |
| FUNCTION F (A : CACCR2) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (2); |
| END F; |
| |
| FUNCTION F (A : NCACCR1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (3); |
| END F; |
| |
| BEGIN |
| IF F (CACCR (AR)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" ); |
| END IF; |
| |
| IF F (CACCR (AR1)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" ); |
| END IF; |
| |
| IF F (CACCR1 (AR2)) /= 1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" ); |
| END IF; |
| |
| IF F (CACCR2 (NAR)) /= 2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" ); |
| END IF; |
| |
| IF F (NCACCR1 (AR)) /= 3 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "CONSTRAINED ACCESS TYPES" ); |
| END; |
| |
| DECLARE |
| PACKAGE PKG1 IS |
| TYPE PRIV IS PRIVATE; |
| PRIVATE |
| TYPE PRIV IS |
| RECORD |
| NULL; |
| END RECORD; |
| END PKG1; |
| |
| USE PKG1; |
| |
| PACKAGE PKG2 IS |
| R : PRIV; |
| |
| TYPE PRIV1 IS NEW PRIV; |
| R1 : PRIV1; |
| |
| TYPE PRIV2 IS NEW PRIV; |
| R2 : PRIV2; |
| END PKG2; |
| |
| USE PKG2; |
| |
| PACKAGE PKG3 IS |
| TYPE NPRIV1 IS NEW PRIV1; |
| NR : NPRIV1; |
| END PKG3; |
| |
| USE PKG3; |
| BEGIN |
| IF PRIV (R) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" ); |
| END IF; |
| |
| IF PRIV (R1) /= R THEN |
| FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" ); |
| END IF; |
| |
| IF PRIV1 (R2) /= R1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" ); |
| END IF; |
| |
| IF PRIV2 (NR) /= R2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" ); |
| END IF; |
| |
| IF NPRIV1 (R) /= NR THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "PRIVATE TYPES" ); |
| END; |
| |
| DECLARE |
| TASK TYPE TK; |
| T : TK; |
| |
| TYPE TK1 IS NEW TK; |
| T1 : TK1; |
| |
| TYPE TK2 IS NEW TK; |
| T2 : TK2; |
| |
| TYPE NTK1 IS NEW TK1; |
| NT : NTK1; |
| |
| TASK BODY TK IS |
| BEGIN |
| NULL; |
| END; |
| |
| FUNCTION F (T : TK) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (0); |
| END F; |
| |
| FUNCTION F (T : TK1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (1); |
| END F; |
| |
| FUNCTION F (T : TK2) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (2); |
| END F; |
| |
| FUNCTION F (T : NTK1) RETURN INTEGER IS |
| BEGIN |
| RETURN IDENT_INT (3); |
| END F; |
| |
| BEGIN |
| IF F (TK (T)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" ); |
| END IF; |
| |
| IF F (TK (T1)) /= 0 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" ); |
| END IF; |
| |
| IF F (TK1 (T2)) /= 1 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" ); |
| END IF; |
| |
| IF F (TK2 (NT)) /= 2 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" ); |
| END IF; |
| |
| IF F (NTK1 (T)) /= 3 THEN |
| FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" ); |
| END IF; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & |
| "TASK TYPES" ); |
| END; |
| |
| RESULT; |
| END C46051A; |
