Add new tests.

From-SVN: r127853

diff --git a/gcc/testsuite/gnat.dg/prefix2.adb b/gcc/testsuite/gnat.dg/prefix2.adb
new file mode 100644 (file)
index 0000000..562bdf4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prefix2.adb
@@ -0,0 +1,31 @@
+--  { dg-do compile }
+
+    package body prefix2 is
+       procedure Positionne (Objet : in out Instance; X, Y :  Coordonnee) is
+       begin
+          Objet.X := X;
+          Objet.Y := Y;
+       end Positionne;
+       function RetourneX (Objet : in Instance) return Coordonnee is
+       begin
+          return Objet.X;
+       end RetourneX;
+       function RetourneY (Objet : in Instance) return Coordonnee is
+       begin
+          return Objet.Y;
+       end RetourneY;
+       procedure Affiche (Objet : in Class; EstVisible : Boolean) is 
+       begin
+          if EstVisible then
+             Objet.Allume;
+          else
+             Objet.Eteins;
+          end if;
+       end Affiche;
+       procedure Deplace (Objet : in out Class; DX, DY : Coordonnee) is
+       begin
+          Objet.Affiche (False);  -- erreur
+          Objet.Positionne (Objet.X + DX, Objet.Y + DY);
+          Objet.Affiche (True);   -- erreur
+       end Deplace;
+    end prefix2;

diff --git a/gcc/testsuite/gnat.dg/prefix2.ads b/gcc/testsuite/gnat.dg/prefix2.ads
new file mode 100644 (file)
index 0000000..5e7b2b2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prefix2.ads
@@ -0,0 +1,17 @@
+
+    package prefix2 is
+       type Coordonnee is range -100 .. 100;
+       type Instance is abstract tagged private;
+       subtype Class is Instance'Class;
+       procedure Positionne (Objet : in out Instance; X, Y :  Coordonnee);
+       function RetourneX (Objet : in Instance) return Coordonnee;
+       function RetourneY (Objet : in Instance) return Coordonnee;
+       procedure Allume (Objet : in Instance) is abstract;
+       procedure Eteins (Objet : in Instance) is abstract;
+       procedure Affiche (Objet : in Class; EstVisible : Boolean);
+       procedure Deplace (Objet : in out Class; DX, DY : Coordonnee);
+    private
+       type Instance is abstract tagged record
+          X, Y : Coordonnee := 0;
+       end record;
+    end;

diff --git a/gcc/testsuite/gnat.dg/remote_type.adb b/gcc/testsuite/gnat.dg/remote_type.adb
new file mode 100644 (file)
index 0000000..788f795
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/remote_type.adb
@@ -0,0 +1,26 @@
+--  { dg-do compile }
+--  { dg-options "-gnatws" }
+
+package body remote_type is
+   procedure Append
+     (Container : in out List;
+      New_Item  : in     Element_Type)
+   is
+   begin
+      null;
+   end Append;
+   procedure Read
+     (S : access Root_Stream_Type'Class;
+      L : out List)
+   is
+   begin
+      null;
+   end Read;
+   procedure Write
+     (S : access Root_Stream_Type'Class;
+      L : in List)
+   is
+   begin
+      null;
+   end Write;
+end remote_type;

diff --git a/gcc/testsuite/gnat.dg/remote_type.ads b/gcc/testsuite/gnat.dg/remote_type.ads
new file mode 100644 (file)
index 0000000..79c2710
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/remote_type.ads
@@ -0,0 +1,24 @@
+with Ada.Streams;
+generic
+   type Element_Type is private;
+package remote_type is
+   pragma Remote_Types;
+   type List is private;
+   procedure Append
+     (Container : in out List;
+      New_Item  : in     Element_Type);
+private
+   use Ada.Streams;
+   type List_Record is record
+      A : Boolean;
+   end record;
+   type List is access List_Record;
+   procedure Read
+     (S : access Root_Stream_Type'Class;
+      L : out List);
+   for List'Read use Read;
+   procedure Write
+     (S : access Root_Stream_Type'Class;
+      L : in List);
+   for List'Write use Write;
+end remote_type;

diff --git a/gcc/testsuite/gnat.dg/specs/ai_116.ads b/gcc/testsuite/gnat.dg/specs/ai_116.ads
new file mode 100644 (file)
index 0000000..88d7e98
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/ai_116.ads
@@ -0,0 +1,23 @@
+--  { dg-do compile }
+
+with Ada.Finalization; use Ada;
+package ai_116 is
+   pragma Preelaborate;
+   type Buffer_Type is limited interface;
+
+   type Handle is new Finalization.Limited_Controlled and Buffer_Type with
+     private;
+   pragma Preelaborable_Initialization(Handle);
+
+   type Ptr is access all String;
+   Null_Handle : constant Handle;
+
+private
+   type Handle is new Finalization.Limited_Controlled and Buffer_Type with
+      record
+         Data     : Ptr  := null;
+      end record;
+
+   Null_Handle : constant Handle :=
+     (Finalization.Limited_Controlled with Data => null);
+end ai_116;

diff --git a/gcc/testsuite/gnat.dg/specs/private_with.ads b/gcc/testsuite/gnat.dg/specs/private_with.ads
new file mode 100644 (file)
index 0000000..f339e5a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/private_with.ads
@@ -0,0 +1,16 @@
+--  { dg-do compile }
+
+private with Ada.Containers.Ordered_Maps;
+with Ada.Containers.Ordered_Sets;
+with Ada.Unchecked_Deallocation;
+package private_with is
+
+   type String_Access is access String;
+
+   package Index_Sets is new Ada.Containers.Ordered_Sets
+     (Element_Type => Positive);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => String,
+      Name   => String_Access);
+end;

diff --git a/gcc/testsuite/gnat.dg/specs/with_containers.ads b/gcc/testsuite/gnat.dg/specs/with_containers.ads
new file mode 100644 (file)
index 0000000..f2329cf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/with_containers.ads
@@ -0,0 +1,27 @@
+--  { dg-do compile }
+
+pragma Warnings (Off);
+with Ada.Containers.Doubly_Linked_Lists;
+with Ada.Containers.Hashed_Maps;
+with Ada.Containers.Hashed_Sets;
+with Ada.Containers.Indefinite_Doubly_Linked_Lists;
+with Ada.Containers.Indefinite_Hashed_Maps;
+with Ada.Containers.Indefinite_Hashed_Sets;
+with Ada.Containers.Indefinite_Ordered_Maps;
+with Ada.Containers.Indefinite_Ordered_Multisets;
+with Ada.Containers.Indefinite_Ordered_Sets;
+with Ada.Containers.Indefinite_Vectors;
+with Ada.Containers.Ordered_Maps;
+with Ada.Containers.Ordered_Multisets;
+with Ada.Containers.Ordered_Sets;
+with Ada.Containers.Prime_Numbers;
+with Ada.Containers.Red_Black_Trees.Generic_Keys;
+with Ada.Containers.Red_Black_Trees.Generic_Operations;
+with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
+with Ada.Containers.Red_Black_Trees;
+with Ada.Containers.Restricted_Doubly_Linked_Lists;
+with Ada.Containers.Vectors;
+        
+package With_Containers is
+   pragma Remote_Types; 
+end With_Containers;

diff --git a/gcc/testsuite/gnat.dg/test_table1.adb b/gcc/testsuite/gnat.dg/test_table1.adb
new file mode 100644 (file)
index 0000000..64155bf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_table1.adb
@@ -0,0 +1,40 @@
+--  { dg-do run }
+
+with GNAT.Table;
+with Ada.Text_IO; use Ada.Text_IO;
+ 
+procedure test_table1 is
+   type Rec is record
+     A, B, C, D, E : Integer := 0;
+     F, G, H, I, J : Integer := 1;
+     K, L, M, N, O : Integer := 2;
+   end record;
+   
+   R : Rec;
+        
+   package Tab is new GNAT.Table (Rec, Positive, 1, 4, 30);
+        
+   Last : Natural;
+        
+begin   
+   R.O := 3;
+        
+   Tab.Append (R);
+
+   for J in 1 .. 1_000_000 loop
+      Last := Tab.Last;
+      begin
+         Tab.Append (Tab.Table (Last));
+      exception
+         when others =>
+             Put_Line ("exception raise for J =" & J'Img);
+             raise;
+      end;
+
+      if Tab.Table (Tab.Last) /= R then
+         Put_Line ("Last is not what is expected");
+         Put_Line (J'Img);
+         return;
+      end if;
+   end loop;
+end;