From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 26 Mar 2008 08:07:07 +0000 (+0100)
Subject: New tests
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a03cc04adeb5fc670bab991aa2380e83dbf0b988;p=gcc.git

New tests

From-SVN: r133593
---

diff --git a/gcc/testsuite/gnat.dg/forward_anon.adb b/gcc/testsuite/gnat.dg/forward_anon.adb
new file mode 100644
index 00000000000..bce495e228e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/forward_anon.adb
@@ -0,0 +1,8 @@
+--  { dg-do compile }
+
+package body Forward_Anon is
+   function Get_Current return access Object is
+   begin
+      return Current_Object;
+   end;
+end;
diff --git a/gcc/testsuite/gnat.dg/forward_anon.ads b/gcc/testsuite/gnat.dg/forward_anon.ads
new file mode 100644
index 00000000000..ff68ff400d3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/forward_anon.ads
@@ -0,0 +1,9 @@
+package Forward_Anon is
+   type Object is null record; 
+   function Get_Current return access Object;
+   Current_Object : constant access Object;
+        
+ private
+   One_Object : aliased Object;
+   Current_Object : constant access Object := One_Object'Access;
+end;
diff --git a/gcc/testsuite/gnat.dg/iface1.ads b/gcc/testsuite/gnat.dg/iface1.ads
new file mode 100644
index 00000000000..bfe90a30320
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iface1.ads
@@ -0,0 +1,12 @@
+generic
+   type Data is private;
+package Iface1 is
+   type Future is synchronized interface;
+   type Any_Future is access all Future;
+
+   procedure Get (This : in out Future; P : out Data) is abstract;
+   procedure Set (This : in out Future; P : in Data) is abstract;
+
+   type Reusable_Future is synchronized interface and Future;
+   type Any_Reusable_Future is access all Reusable_Future'Class;
+end Iface1;
diff --git a/gcc/testsuite/gnat.dg/iface2.adb b/gcc/testsuite/gnat.dg/iface2.adb
new file mode 100644
index 00000000000..c565599521e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iface2.adb
@@ -0,0 +1,7 @@
+--  { dg-do compile }
+package body Iface2 is
+   procedure change (This, That : Prot.Any_Future) is
+   begin
+      null;
+   end;
+end Iface2;
diff --git a/gcc/testsuite/gnat.dg/iface2.ads b/gcc/testsuite/gnat.dg/iface2.ads
new file mode 100644
index 00000000000..d25bc4246c0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iface2.ads
@@ -0,0 +1,6 @@
+with Iface1;
+generic
+   with package Prot is new Iface1 (<>);
+package Iface2 is
+   procedure change (This, That : Prot.Any_Future);
+end Iface2;
diff --git a/gcc/testsuite/gnat.dg/init_scalar1.adb b/gcc/testsuite/gnat.dg/init_scalar1.adb
new file mode 100644
index 00000000000..2688e929896
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/init_scalar1.adb
@@ -0,0 +1,16 @@
+--  { dg-do run }
+--  { dg-options "-gnatws -gnatVa" }
+
+pragma Initialize_Scalars;
+procedure init_scalar1 is
+  type Fixed_3T is delta 2.0 ** (- 4)
+      range - 2.0 ** 19 ..  (2.0 ** 19 - 2.0 ** (- 4));
+  for Fixed_3T'Size use 3*8;
+
+  Write_Value : constant Fixed_3T := Fixed_3T(524287.875);
+  type singleton is array (1 .. 1) of Fixed_3T;
+  pragma Pack (singleton);
+  it : Singleton;
+begin
+   null;
+end;
diff --git a/gcc/testsuite/gnat.dg/self1.adb b/gcc/testsuite/gnat.dg/self1.adb
new file mode 100644
index 00000000000..dc6f485b8fe
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/self1.adb
@@ -0,0 +1,21 @@
+--  { dg-do compile }
+
+procedure Self1 is      
+   type Event;
+        
+   type Link (E : access Event) is limited record
+      Val : Integer;
+   end record;
+
+   type Ptr is access all Event;
+   
+   type Event is tagged limited record
+      Inner : Link (Event'access);
+      Size  : Integer;
+   end record;              
+        
+   Obj2 : Ptr := new Event'(Inner => (Event'access, 15),
+                            Size => Link'size);
+begin
+   null;                    
+end;    
diff --git a/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads b/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads
new file mode 100644
index 00000000000..cfd84699426
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads
@@ -0,0 +1,10 @@
+--  { dg-do compile }
+--  { dg-options "-gnatc" }
+
+pragma Restrictions (No_Entry_Queue);
+package Restricted_Pkg is
+   type Iface is limited interface;
+   protected type PO is new Iface with
+      procedure Dummy;
+   end; 
+end;    
diff --git a/gcc/testsuite/gnat.dg/test_bip_no_alloc.adb b/gcc/testsuite/gnat.dg/test_bip_no_alloc.adb
new file mode 100644
index 00000000000..82973147e3a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_bip_no_alloc.adb
@@ -0,0 +1,24 @@
+--  { dg-do compile }
+
+pragma Restrictions (No_Allocators);
+procedure Test_BIP_No_Alloc is
+
+   type LR (B : Boolean) is limited record
+      X : Integer;
+   end record;
+
+   function FLR return LR is
+   begin
+      --  A return statement in a function with a limited and unconstrained
+      --  result subtype can result in expansion of an allocator for the
+      --  secondary stack, but that should not result in a violation of the
+      --  restriction No_Allocators.
+
+      return (B => False, X => 123);
+   end FLR;
+
+   Obj : LR := FLR;
+
+begin
+   null;
+end Test_BIP_No_Alloc;
diff --git a/gcc/testsuite/gnat.dg/too_many_tasks.adb b/gcc/testsuite/gnat.dg/too_many_tasks.adb
new file mode 100644
index 00000000000..5d01570d634
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/too_many_tasks.adb
@@ -0,0 +1,25 @@
+-- { dg-do run }
+
+procedure too_many_tasks is 
+   Global : Natural := 0;
+   function Output return Integer is
+   begin
+      Global := Global + 1;
+      return Global;
+   end Output;
+        
+   task type A;
+   task type B;
+        
+   task body A is
+      I : Integer := Output;
+      T : B;
+   begin null; end A;
+        
+   task body B is
+      I : Integer := Output;
+      T : A;
+   begin null; end B; 
+        
+   T : A;
+begin null; end;