OSDN Git Service

Add new tests.
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 31 Aug 2007 10:25:23 +0000 (10:25 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 31 Aug 2007 10:25:23 +0000 (10:25 +0000)
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127985 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/gnat.dg/addr3.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/aggr8.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/no_exc_prop.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/no_exc_prop.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/tag1.adb [new file with mode: 0644]

diff --git a/gcc/testsuite/gnat.dg/addr3.adb b/gcc/testsuite/gnat.dg/addr3.adb
new file mode 100644 (file)
index 0000000..837035a
--- /dev/null
@@ -0,0 +1,36 @@
+--  { dg-do compile }
+
+with text_io;
+with System;
+procedure addr3 is
+  
+  Type T_SAME_TYPE is new System.Address;
+  
+  Type T_OTHER_TYPE is new System.Address;
+  
+  I : constant integer := 0;                                                   
+                                                                                  procedure dum ( i : INTEGER ) is
+  begin
+    text_io.put_line ("Integer op");
+    null;
+  end;
+  
+  procedure dum ( i : system.ADDRESS ) is
+  begin
+    null;
+  end;
+  
+  procedure dum ( i : T_SAME_TYPE ) is
+  begin
+    null;
+  end;
+  
+  procedure dum ( i : T_OTHER_TYPE ) is
+  begin
+    null;
+  end;
+
+begin
+   dum( I );
+   dum( 1 );
+end; 
diff --git a/gcc/testsuite/gnat.dg/aggr8.adb b/gcc/testsuite/gnat.dg/aggr8.adb
new file mode 100644 (file)
index 0000000..457150e
--- /dev/null
@@ -0,0 +1,22 @@
+--  { dg-do compile }
+
+procedure aggr8 is
+   
+   type Byte is mod 2 ** 8;
+   subtype two is integer range 1..2;
+   -- type Sequence is array (1 .. 2) of Byte;
+   type Sequence is array (Two) of Byte;
+   
+   type Block is record
+      Head : Sequence  := (11, 22);
+   end record;
+   
+   procedure Nest is
+      Blk : Block;  pragma Unreferenced (Blk);
+   begin
+      null;
+   end;
+
+begin
+   null;
+end;
diff --git a/gcc/testsuite/gnat.dg/no_exc_prop.adb b/gcc/testsuite/gnat.dg/no_exc_prop.adb
new file mode 100644 (file)
index 0000000..68e2b1d
--- /dev/null
@@ -0,0 +1,15 @@
+--  { dg-do compile }
+--  { dg-options "-gnatwa" }
+
+package body no_exc_prop is
+   protected body Simple_Barrier is
+      entry Wait when Signaled is
+      begin
+        Signaled := False;
+      end Wait;
+      procedure Signal is
+      begin
+        Signaled := True;
+      end Signal;
+   end Simple_Barrier;
+end no_exc_prop;
diff --git a/gcc/testsuite/gnat.dg/no_exc_prop.ads b/gcc/testsuite/gnat.dg/no_exc_prop.ads
new file mode 100644 (file)
index 0000000..ef3caa3
--- /dev/null
@@ -0,0 +1,9 @@
+pragma Restrictions (No_Exception_Propagation);
+package no_exc_prop is
+   protected Simple_Barrier is
+      entry Wait;
+      procedure Signal;
+   private
+         Signaled : Boolean := False;
+   end Simple_Barrier;
+end no_exc_prop;
diff --git a/gcc/testsuite/gnat.dg/tag1.adb b/gcc/testsuite/gnat.dg/tag1.adb
new file mode 100644 (file)
index 0000000..f973cb2
--- /dev/null
@@ -0,0 +1,20 @@
+--  { dg-do run }
+
+with Ada.Tags;
+procedure tag1 is
+   type T is tagged null record;
+   X : Ada.Tags.Tag;
+begin
+   begin
+     X := Ada.Tags.Descendant_Tag ("Internal tag at 16#0#", T'Tag);
+     raise Program_Error;
+   exception
+     when Ada.Tags.Tag_Error => null; 
+   end;
+   begin
+     X := Ada.Tags.Descendant_Tag ("Internal tag at 16#XXXX#", T'Tag);
+     raise Program_Error;
+   exception
+     when Ada.Tags.Tag_Error => null;
+   end; 
+end;