llvm-gcc-4.2/gcc/testsuite/ada/acats/tests/cc/cc51008.a

-- CC51008.A
--
--                             Grant of Unlimited Rights
--
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
--     rights in the software and documentation contained herein. Unlimited
--     rights are the same as those granted by the U.S. Government for older
--     parts of the Ada Conformity Assessment Test Suite, and are defined
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
--     intends to confer upon all recipients unlimited rights equal to those
--     held by the ACAA. 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 ACAA 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:
--    Check that operations are inherited for a formal derived type whose
--    ancestor is also a formal type as described in the corrigendum.
--    (Defect Report 8652/0038, as reflected in Technical Corrigendum 1,
--    RM95 12.5.1(21/1)).
--
-- CHANGE HISTORY:
--    29 Jan 2001   PHL   Initial version.
--    30 Apr 2002   RLB   Readied for release.
--
--!
package CC51008_0 is

    type R0 is
	record
	    C : Float;
	end record;

    procedure S (X : R0);

end CC51008_0;

with Report;
use Report;
package body CC51008_0 is
    procedure S (X : R0) is
    begin
	Comment ("CC51008_0.S called");
    end S;
end CC51008_0;

with CC51008_0;
generic
    type F1 is new CC51008_0.R0;
    type F2 is new F1;
package CC51008_1 is
    procedure G (O1 : F1; O2 : F2);
end CC51008_1;

package body CC51008_1 is
    procedure G (O1 : F1; O2 : F2) is
    begin
	S (O1);
	S (O2);
    end G;
end CC51008_1;

with CC51008_0;
package CC51008_2 is
    type R2 is new CC51008_0.R0;
    procedure S (X : out R2);
end CC51008_2;

with Report;
use Report;
package body CC51008_2 is
    procedure S (X : out R2) is
    begin
	Failed ("CC51008_2.S called");
    end S;
end CC51008_2;

with CC51008_2;
package CC51008_3 is
    type R3 is new CC51008_2.R2;
    procedure S (X : R3);
end CC51008_3;

with Report;
use Report;
package body CC51008_3 is
    procedure S (X : R3) is
    begin
	Failed ("CC51008_3.S called");
    end S;
end CC51008_3;

with CC51008_1;
with CC51008_2;
with CC51008_3;
with Report;
use Report;
procedure CC51008 is

    package Inst is new CC51008_1 (CC51008_2.R2,
				   CC51008_3.R3);

    X2 : constant CC51008_2.R2 := (C => 2.0);
    X3 : constant CC51008_3.R3 := (C => 3.0);

begin
    Test ("CC51008",
	  "Check that operations are inherited for a formal derived " &
	     "type whose ancestor is also a formal type as described in " &
	     "RM95 12.5.1(21/1)");
    Inst.G (X2, X3);
    Result;
end CC51008;