-- CC3120A.ADA -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and -- F08630-91-C-0015, 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 GENERIC IN PARAMETERS ARE ALWAYS COPIED, AND THAT -- GENERIC IN OUT PARAMETERS ARE ALWAYS RENAMED. -- DAT 8/10/81 -- SPS 10/21/82 WITH REPORT; USE REPORT; PROCEDURE CC3120A IS BEGIN TEST ("CC3120A", "GENERIC IN PARMS ARE COPIED, GENERIC IN OUT" & " PARMS ARE RENAMED"); DECLARE S1, S2 : INTEGER; A1, A2, A3 : STRING (1 .. IDENT_INT (3)); TYPE REC IS RECORD C1, C2 : INTEGER := 1; END RECORD; R1, R2 : REC; PACKAGE P IS TYPE PRIV IS PRIVATE; PROCEDURE SET_PRIV (P : IN OUT PRIV); PRIVATE TYPE PRIV IS NEW REC; END P; USE P; P1, P2 : PRIV; EX : EXCEPTION; GENERIC TYPE T IS PRIVATE; P1 : IN OUT T; P2 : IN T; PROCEDURE GP; B_ARR : ARRAY (1..10) OF BOOLEAN; PACKAGE BODY P IS PROCEDURE SET_PRIV (P : IN OUT PRIV) IS BEGIN P.C1 := 3; END SET_PRIV; END P; PROCEDURE GP IS BEGIN IF P1 = P2 THEN FAILED ("PARAMETER SCREW_UP SOMEWHERE"); END IF; P1 := P2; IF P1 /= P2 THEN FAILED ("ASSIGNMENT SCREW_UP SOMEWHERE"); END IF; RAISE EX; FAILED ("RAISE STATEMENT DOESN'T WORK"); END GP; BEGIN S1 := 4; S2 := 5; A1 := "XYZ"; A2 := "ABC"; A3 := "DEF"; R1.C1 := 4; R2.C1 := 5; B_ARR := (1|3|5|7|9 => TRUE, 2|4|6|8|10 => FALSE); SET_PRIV (P2); IF S1 = S2 OR A1 = A3 OR R1 = R2 OR P1 = P2 THEN FAILED ("WRONG ASSIGNMENT"); END IF; BEGIN DECLARE PROCEDURE PR IS NEW GP (INTEGER, S1, S2); BEGIN S2 := S1; PR; -- OLD S2 ASSIGNED TO S1, SO S1 /= S2 NOW FAILED ("EX NOT RAISED 1"); EXCEPTION WHEN EX => NULL; END; DECLARE SUBTYPE STR_1_3 IS STRING (IDENT_INT (1)..3); PROCEDURE PR IS NEW GP (STR_1_3, A1, A3); BEGIN A3 := A1; PR; FAILED ("EX NOT RAISED 2"); EXCEPTION WHEN EX => NULL; END; DECLARE PROCEDURE PR IS NEW GP (REC, R1, R2); BEGIN R2 := R1; PR; FAILED ("EX NOT RAISED 3"); EXCEPTION WHEN EX => NULL; END; DECLARE PROCEDURE PR IS NEW GP (PRIV, P1, P2); BEGIN P2 := P1; PR; FAILED ("EX NOT RAISED 4"); EXCEPTION WHEN EX => NULL; END; DECLARE PROCEDURE PR IS NEW GP (CHARACTER, A3(IDENT_INT(2)), A3(IDENT_INT(3))); BEGIN A3(3) := A3(2); PR; FAILED ("EX NOT RAISED 5"); EXCEPTION WHEN EX => NULL; END; DECLARE PROCEDURE PR IS NEW GP (BOOLEAN, B_ARR(IDENT_INT(2)), B_ARR(IDENT_INT(3))); BEGIN B_ARR(3) := B_ARR(2); PR; FAILED ("EX NOT RAISED 6"); EXCEPTION WHEN EX => NULL; END; END; IF S1 = S2 OR A1 = A2 OR R1 = R2 OR P1 = P2 OR A3(2) = A3(3) OR B_ARR(2) = B_ARR(3) THEN FAILED ("ASSIGNMENT FAILED 2"); END IF; END; RESULT; END CC3120A;