* 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
+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
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>
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;