OSDN Git Service

Add test cases.
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Aug 2007 08:06:48 +0000 (08:06 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Aug 2007 08:06:48 +0000 (08:06 +0000)
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127533 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/gnat.dg/addr2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/addr2_p.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/addr2_p.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/aliased1.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/profile_warning.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/profile_warning.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/profile_warning_p.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/profile_warning_p.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/range_check.adb [new file with mode: 0644]

diff --git a/gcc/testsuite/gnat.dg/addr2.adb b/gcc/testsuite/gnat.dg/addr2.adb
new file mode 100644 (file)
index 0000000..15d51e3
--- /dev/null
@@ -0,0 +1,10 @@
+--  { dg-do run }
+
+with addr2_p; use addr2_p;
+procedure addr2 is
+begin
+   Process (B1);
+   Process (Blk => B1);
+   Process (B2);
+   Process (Blk => B2);
+end;
diff --git a/gcc/testsuite/gnat.dg/addr2_p.adb b/gcc/testsuite/gnat.dg/addr2_p.adb
new file mode 100644 (file)
index 0000000..82e151c
--- /dev/null
@@ -0,0 +1,11 @@
+
+with System;
+package body addr2_p is
+   procedure Process (Blk : Block) is
+      use type System.Address;
+   begin
+      if Blk'Address /= B1'Address and then Blk'Address /= B2'Address then
+         raise Program_Error;
+      end if;
+   end;
+end;
diff --git a/gcc/testsuite/gnat.dg/addr2_p.ads b/gcc/testsuite/gnat.dg/addr2_p.ads
new file mode 100644 (file)
index 0000000..b85d13a
--- /dev/null
@@ -0,0 +1,10 @@
+
+package addr2_p is
+   
+   type Block is array (1 .. 4) of Integer;
+   
+   procedure Process (Blk : Block);
+   
+   B1 : constant Block := Block'((1,2,3,4));
+   B2 : constant Block := (1,2,3,4);
+end;
diff --git a/gcc/testsuite/gnat.dg/aliased1.adb b/gcc/testsuite/gnat.dg/aliased1.adb
new file mode 100644 (file)
index 0000000..774ffe5
--- /dev/null
@@ -0,0 +1,34 @@
+--  { dg-do compile }
+--  { dg-options "-gnatws" }
+
+procedure aliased1 is
+  
+  type E is (One, Two);
+  
+  type R (D : E := One) is record
+    case D is
+      when One =>
+         I1 : Integer;
+         I2 : Integer;
+      when Two =>
+         B1 : Boolean;
+    end case;
+  end record;
+  
+  type Data_Type is record
+    Data : R;
+  end record;
+  
+  type Array_Type is array (Natural range <>) of Data_Type;
+  
+  function Get return Array_Type is
+    Ret : Array_Type (1 .. 2);
+  begin
+    return Ret;
+  end;
+  
+  Object : aliased Array_Type := Get;
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/profile_warning.adb b/gcc/testsuite/gnat.dg/profile_warning.adb
new file mode 100644 (file)
index 0000000..3bdc58e
--- /dev/null
@@ -0,0 +1,4 @@
+-- { dg-do compile }
+
+package body profile_warning is
+end;
diff --git a/gcc/testsuite/gnat.dg/profile_warning.ads b/gcc/testsuite/gnat.dg/profile_warning.ads
new file mode 100644 (file)
index 0000000..475d837
--- /dev/null
@@ -0,0 +1,6 @@
+pragma Profile_Warnings (Ravenscar);
+with profile_warning_p;
+package profile_warning is
+   pragma Elaborate_Body;
+   procedure I is new profile_warning_p.Proc;
+end;
diff --git a/gcc/testsuite/gnat.dg/profile_warning_p.adb b/gcc/testsuite/gnat.dg/profile_warning_p.adb
new file mode 100644 (file)
index 0000000..455237a
--- /dev/null
@@ -0,0 +1,20 @@
+package body profile_warning_p is
+   procedure Proc is begin null; end Proc;
+   
+   task type T is
+   end T;
+   
+   task body T is
+   begin
+      null;
+   end;
+   
+   type A_T is access T;
+   
+   procedure Do_Stuff is
+      P : A_T;
+   begin
+      P := new T;
+   end Do_Stuff;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/profile_warning_p.ads b/gcc/testsuite/gnat.dg/profile_warning_p.ads
new file mode 100644 (file)
index 0000000..6c78d45
--- /dev/null
@@ -0,0 +1,4 @@
+package profile_warning_p is
+   generic
+   procedure Proc;
+end;
diff --git a/gcc/testsuite/gnat.dg/range_check.adb b/gcc/testsuite/gnat.dg/range_check.adb
new file mode 100644 (file)
index 0000000..18839a1
--- /dev/null
@@ -0,0 +1,20 @@
+-- { dg-do run }
+
+procedure range_check is
+   function ident (x : integer) return integer is
+   begin   
+      return x;
+   end ident;
+
+   guard1 : Integer;
+
+   r : array (1 .. ident (10)) of integer;
+   pragma Suppress (Index_Check, r);
+
+   guard2 : Integer;
+
+begin
+   guard1 := 0;
+   guard2 := 0;
+   r (11) := 3;
+end;