URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74402a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C74402A.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 A SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A -- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE -- THE PACKAGE THAT DECLARES THE LIMITED TYPE. -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.) -- DSJ 5/6/83 -- SPS 10/24/83 WITH REPORT; PROCEDURE C74402A IS USE REPORT; BEGIN TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " & "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF " & "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " & "THAT DECLARES THE LIMITED TYPE"); DECLARE PACKAGE PACK1 IS TYPE LP1 IS LIMITED PRIVATE; TYPE LP2 IS ARRAY (1 .. 2) OF LP1; TYPE LP3 IS RECORD C1, C2 : LP2; END RECORD; FUNCTION F1 RETURN LP1; FUNCTION F2 RETURN LP2; FUNCTION F3 RETURN LP3; PROCEDURE G1 (X : LP1 := F1); -- LEGAL PROCEDURE G2 (X : LP2 := F2); -- LEGAL PROCEDURE G3 (X : LP3 := F3); -- LEGAL PRIVATE TYPE LP1 IS NEW INTEGER; END PACK1; PACKAGE BODY PACK1 IS FUNCTION F1 RETURN LP1 IS BEGIN RETURN LP1'(1); END F1; FUNCTION F2 RETURN LP2 IS BEGIN RETURN LP2'(2,3); END F2; FUNCTION F3 RETURN LP3 IS BEGIN RETURN LP3'((4,5),(6,7)); END F3; PROCEDURE G1 (X : LP1 := F1) IS BEGIN IF X /= LP1'(1) THEN FAILED("WRONG DEFAULT VALUE - LP1"); END IF; END G1; PROCEDURE G2 (X : LP2 := F2) IS BEGIN IF X /= LP2'(2,3) THEN FAILED("WRONG DEFAULT VALUE - LP2"); END IF; END G2; PROCEDURE G3 (X : LP3 := F3) IS BEGIN IF X /= LP3'((4,5),(6,7)) THEN FAILED("WRONG DEFAULT VALUE - LP3"); END IF; END G3; BEGIN G1; -- LEGAL, DEFAULT USED G2; -- LEGAL, DEFAULT USED G3; -- LEGAL, DEFAULT USED G1(F1); -- LEGAL G2(F2); -- LEGAL G3(F3); -- LEGAL END PACK1; USE PACK1; PROCEDURE G4 (X : LP1 := F1) IS BEGIN G1; -- LEGAL, DEFAULT USED G1(X); END G4; PROCEDURE G5 (X : LP2 := F2) IS BEGIN G2; -- LEGAL, DEFAULT USED G2(X); END G5; PROCEDURE G6 (X : LP3 := F3) IS BEGIN G3; -- DEFAULT USED G3(X); END G6; BEGIN G4; -- LEGAL, DEFAULT USED G5; -- LEGAL, DEFAULT USED G6; -- LEGAL, DEFAULT USED G4(F1); -- LEGAL G5(F2); -- LEGAL G6(F3); -- LEGAL END; RESULT; END C74402A;