Add new tests
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 15 Jun 2007 08:27:59 +0000 (08:27 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 15 Jun 2007 08:27:59 +0000 (08:27 +0000)
git-svn-id: svn://gcc.gnu.org/svn/gcc/trunk@125738 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/gnat.dg/aggr7.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/c_words.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/c_words.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/cpp1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/tag1.ads [new file with mode: 0644]

diff --git a/gcc/testsuite/gnat.dg/aggr7.adb b/gcc/testsuite/gnat.dg/aggr7.adb
new file mode 100644 (file)
index 0000000..9ebec1c
--- /dev/null
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/c_words.adb b/gcc/testsuite/gnat.dg/c_words.adb
new file mode 100644 (file)
index 0000000..dff8716
--- /dev/null
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/c_words.ads b/gcc/testsuite/gnat.dg/c_words.ads
new file mode 100644 (file)
index 0000000..b87a19b
--- /dev/null
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/specs/cpp1.ads b/gcc/testsuite/gnat.dg/specs/cpp1.ads
new file mode 100644 (file)
index 0000000..1f759b7
--- /dev/null
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/specs/tag1.ads b/gcc/testsuite/gnat.dg/specs/tag1.ads
new file mode 100644 (file)
index 0000000..7cf7c99
--- /dev/null
@@ -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;