Add new tests

From-SVN: r125738
This commit is contained in:
Arnaud Charlet 2007-06-15 10:27:59 +02:00
parent 3353afbec7
commit 2be6658d86
5 changed files with 82 additions and 0 deletions

View File

@ -0,0 +1,34 @@
-- { 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;

View File

@ -0,0 +1,14 @@
-- { 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;

View File

@ -0,0 +1,16 @@
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;

View File

@ -0,0 +1,10 @@
-- { 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;

View File

@ -0,0 +1,8 @@
-- { 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;