address_conversion.adb: New test.

	* gnat.dg/address_conversion.adb: New test.
	* gnat.dg/boolean_subtype.adb: Likewise.
	* gnat.dg/frame_overflow.adb: Likewise.
	* gnat.dg/pointer_array.adb: Likewise.
	* gnat.dg/pointer_conversion.adb: Likewise.

From-SVN: r115253

6 files changed, 149 insertions, 1 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 095a51c..6537b28 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-07-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/address_conversion.adb: New test.
+	* gnat.dg/boolean_subtype.adb: Likewise.
+	* gnat.dg/frame_overflow.adb: Likewise.
+	* gnat.dg/pointer_array.adb: Likewise.
+	* gnat.dg/pointer_conversion.adb: Likewise.
+
 2006-07-07  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/28237
@@ -50,7 +58,7 @@
 
 2006-07-03  Eric Botcazou  <ebotcazou@adacore.com>
 
-	* gnat.dg/gnat.dg/string_slice.adb: New test.
+	* gnat.dg/string_slice.adb: New test.
 
 2006-07-01  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
 
diff --git a/gcc/testsuite/gnat.dg/address_conversion.adb b/gcc/testsuite/gnat.dg/address_conversion.adb
new file mode 100644
index 0000000..5813638
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/address_conversion.adb
@@ -0,0 +1,24 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+with System.Address_To_Access_Conversions;
+
+procedure address_conversion is
+
+   type Integer_type1 is new Integer;
+   type Integer_type2 is new Integer;
+
+   package AA is new System.Address_To_Access_Conversions (Integer_type1);
+
+   K1 : Integer_type1;
+   K2 : Integer_type2;
+
+begin
+   K1 := 1;
+   K2 := 2;
+
+   AA.To_Pointer(K2'Address).all := K1;
+   if K2 /= 1 then
+      raise Program_Error;
+   end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/boolean_subtype.adb b/gcc/testsuite/gnat.dg/boolean_subtype.adb
new file mode 100644
index 0000000..3976d79
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/boolean_subtype.adb
@@ -0,0 +1,42 @@
+-- { dg-do compile }
+-- { dg-options "-O2" }
+
+procedure boolean_subtype is
+
+   subtype Component_T is Boolean;
+
+   function Condition return Boolean is
+   begin
+      return True;
+   end;
+
+   V : Integer := 0;
+
+   function Component_Value return Integer is
+   begin
+      V := V + 1;
+      return V;
+   end;
+
+   Most_Significant  : Component_T := False;
+   Least_Significant : Component_T := True;
+
+begin
+
+   if Condition then
+      Most_Significant := True;
+   end if;
+
+   if Condition then
+      Least_Significant := Component_T'Val (Component_Value);
+   end if;
+
+   if Least_Significant < Most_Significant then
+      Least_Significant := Most_Significant;
+   end if;
+
+   if Least_Significant /= True then
+      raise Program_Error;
+   end if;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/frame_overflow.adb b/gcc/testsuite/gnat.dg/frame_overflow.adb
new file mode 100644
index 0000000..4172fc0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/frame_overflow.adb
@@ -0,0 +1,33 @@
+-- { dg-do compile }
+
+procedure frame_overflow is
+
+   type Bitpos_Range_T is new Positive;
+   type Bitmap_Array_T is array (Bitpos_Range_T) of Boolean;
+
+   type Bitmap_T is record
+      Bits : Bitmap_Array_T := (others => False);
+   end record;
+   
+   function -- { dg-error "too large" "" }
+     Set_In (Bitmap : Bitmap_T; Bitpos : Bitpos_Range_T)  return Bitmap_T
+   is
+      Result: Bitmap_T := Bitmap;
+   begin
+      Result.Bits (Bitpos) := True;
+      return Result;
+   end;
+
+   function -- { dg-error "too large" "" }
+     Negate (Bitmap : Bitmap_T) return Bitmap_T is
+      Result: Bitmap_T;
+   begin
+      for E in Bitpos_Range_T loop
+        Result.Bits (E) := not Bitmap.Bits (E);
+      end loop;
+      return Result;
+  end;
+
+begin
+   null;
+end;
diff --git a/gcc/testsuite/gnat.dg/pointer_array.adb b/gcc/testsuite/gnat.dg/pointer_array.adb
new file mode 100644
index 0000000..a1c72da
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pointer_array.adb
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+
+procedure pointer_array is
+
+   type Node;
+   type Node_Ptr is access Node;
+   type Node is array (1..10) of Node_Ptr;
+
+   procedure Process (N : Node_Ptr) is
+   begin
+      null;
+   end;
+
+begin
+   null;
+end;
diff --git a/gcc/testsuite/gnat.dg/pointer_conversion.adb b/gcc/testsuite/gnat.dg/pointer_conversion.adb
new file mode 100644
index 0000000..8ed2e0d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pointer_conversion.adb
@@ -0,0 +1,25 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+with Unchecked_Conversion;
+
+procedure pointer_conversion is
+
+   type int1 is new integer;
+   type int2 is new integer;
+   type a1 is access int1;
+   type a2 is access int2;
+
+   function to_a2 is new Unchecked_Conversion (a1, a2);
+
+   v1 : a1 := new int1;
+   v2 : a2 := to_a2 (v1);
+
+begin
+   v1.all := 1;
+   v2.all := 0;
+
+   if v1.all /= 0 then
+      raise Program_Error;
+   end if;
+end;