Commit b5b18425 by Eric Botcazou Committed by Eric Botcazou

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
parent 01ade80d
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> 2006-07-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28237 PR fortran/28237
...@@ -50,7 +58,7 @@ ...@@ -50,7 +58,7 @@
2006-07-03 Eric Botcazou <ebotcazou@adacore.com> 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 Schlter <tobias.schlueter@physik.uni-muenchen.de> 2006-07-01 Tobias Schlter <tobias.schlueter@physik.uni-muenchen.de>
-- { 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;
-- { 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;
-- { 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;
-- { 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;
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment