From 2be6658d869f5fbf18f38a02b0333a3407d9223f Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Fri, 15 Jun 2007 10:27:59 +0200
Subject: [PATCH] Add new tests

From-SVN: r125738
---
 gcc/testsuite/gnat.dg/aggr7.adb      | 34 ++++++++++++++++++++++++++++
 gcc/testsuite/gnat.dg/c_words.adb    | 14 ++++++++++++
 gcc/testsuite/gnat.dg/c_words.ads    | 16 +++++++++++++
 gcc/testsuite/gnat.dg/specs/cpp1.ads | 10 ++++++++
 gcc/testsuite/gnat.dg/specs/tag1.ads |  8 +++++++
 5 files changed, 82 insertions(+)
 create mode 100644 gcc/testsuite/gnat.dg/aggr7.adb
 create mode 100644 gcc/testsuite/gnat.dg/c_words.adb
 create mode 100644 gcc/testsuite/gnat.dg/c_words.ads
 create mode 100644 gcc/testsuite/gnat.dg/specs/cpp1.ads
 create mode 100644 gcc/testsuite/gnat.dg/specs/tag1.ads

diff --git a/gcc/testsuite/gnat.dg/aggr7.adb b/gcc/testsuite/gnat.dg/aggr7.adb
new file mode 100644
index 00000000000..9ebec1ca8e5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr7.adb
@@ -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
index 00000000000..dff8716401c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/c_words.adb
@@ -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
index 00000000000..b87a19bb1e1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/c_words.ads
@@ -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
index 00000000000..1f759b7a9a1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/cpp1.ads
@@ -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
index 00000000000..7cf7c99dd13
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/tag1.ads
@@ -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;