Commit 2be6658d by Arnaud Charlet

Add new tests

From-SVN: r125738
parent 3353afbe
-- { dg-do compile }
procedure aggr7 is
package P is
type T is limited private;
type TT is limited private;
type TTT is tagged limited private;
private
type T is limited
record
Self : access T := T'Unchecked_Access;
end record;
type TT is tagged limited
record
Self : access TT := TT'Unchecked_Access;
end record;
type TTT is tagged limited
record
Self : access TTT := TTT'Unchecked_Access;
end record;
end P;
package body P is
X : T := (Self => <>);
XX : TT := (Self => <>);
XXX : TTT := (Self => <>);
Y : T := (others => <>);
YY : TT := (others => <>);
YYY : TTT := (others => <>);
end P;
begin
null;
end aggr7;
-- { dg-do compile }
package body C_Words is
function New_Word (Str : String) return Word is
begin
return (Str'Length, Str);
end New_Word;
function New_Word (Str : String) return C_Word is
begin
return (Str'Length, Str);
end New_Word;
end C_Words;
package C_Words is
type Comparable is limited interface;
type Word (<>) is tagged private;
function New_Word (Str : String) return Word;
type C_Word (<>) is new Word and Comparable with private;
function New_Word (Str : String) return C_Word;
private
type Word (Length : Natural) is tagged record
Str : String (1 .. Length) := (others => ' ');
end record;
type C_Word is new Word and Comparable with null record;
end C_Words;
-- { dg-do compile }
package cpp1 is
type Root_Interface is interface;
type Typ is new Root_Interface with record
TOTO : Integer;
pragma CPP_Vtable (TOTO);
end record;
end cpp1;
-- { dg-do compile }
package tag1 is
type T is tagged limited record
Y : access T'Class; -- OK
X : access Tag1.T'Class; -- Problem
end record;
end tag1;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment