From 439cafcf602f14564f086fec1bf832a0c0866d7f Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Thu, 16 Aug 2007 10:06:48 +0200
Subject: [PATCH] Add test cases.

From-SVN: r127533
---
 gcc/testsuite/gnat.dg/addr2.adb             | 10 ++++++
 gcc/testsuite/gnat.dg/addr2_p.adb           | 11 +++++++
 gcc/testsuite/gnat.dg/addr2_p.ads           | 10 ++++++
 gcc/testsuite/gnat.dg/aliased1.adb          | 34 +++++++++++++++++++++
 gcc/testsuite/gnat.dg/profile_warning.adb   |  4 +++
 gcc/testsuite/gnat.dg/profile_warning.ads   |  6 ++++
 gcc/testsuite/gnat.dg/profile_warning_p.adb | 20 ++++++++++++
 gcc/testsuite/gnat.dg/profile_warning_p.ads |  4 +++
 gcc/testsuite/gnat.dg/range_check.adb       | 20 ++++++++++++
 9 files changed, 119 insertions(+)
 create mode 100644 gcc/testsuite/gnat.dg/addr2.adb
 create mode 100644 gcc/testsuite/gnat.dg/addr2_p.adb
 create mode 100644 gcc/testsuite/gnat.dg/addr2_p.ads
 create mode 100644 gcc/testsuite/gnat.dg/aliased1.adb
 create mode 100644 gcc/testsuite/gnat.dg/profile_warning.adb
 create mode 100644 gcc/testsuite/gnat.dg/profile_warning.ads
 create mode 100644 gcc/testsuite/gnat.dg/profile_warning_p.adb
 create mode 100644 gcc/testsuite/gnat.dg/profile_warning_p.ads
 create mode 100644 gcc/testsuite/gnat.dg/range_check.adb

diff --git a/gcc/testsuite/gnat.dg/addr2.adb b/gcc/testsuite/gnat.dg/addr2.adb
new file mode 100644
index 00000000000..15d51e30dc5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr2.adb
@@ -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
index 00000000000..82e151cd777
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr2_p.adb
@@ -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
index 00000000000..b85d13ab0fa
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr2_p.ads
@@ -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
index 00000000000..774ffe5f785
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aliased1.adb
@@ -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
index 00000000000..3bdc58ea529
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/profile_warning.adb
@@ -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
index 00000000000..475d8371373
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/profile_warning.ads
@@ -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
index 00000000000..455237a779f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/profile_warning_p.adb
@@ -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
index 00000000000..6c78d453f5c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/profile_warning_p.ads
@@ -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
index 00000000000..18839a1aaaa
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/range_check.adb
@@ -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;
-- 
2.30.2