mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-12-27 04:55:01 +08:00
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
This commit is contained in:
parent
01ade80d07
commit
b5b1842549
@ -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>
|
2006-07-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/28237
|
PR fortran/28237
|
||||||
@ -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 Schlüter <tobias.schlueter@physik.uni-muenchen.de>
|
2006-07-01 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
|
||||||
|
|
||||||
|
24
gcc/testsuite/gnat.dg/address_conversion.adb
Normal file
24
gcc/testsuite/gnat.dg/address_conversion.adb
Normal file
@ -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;
|
42
gcc/testsuite/gnat.dg/boolean_subtype.adb
Normal file
42
gcc/testsuite/gnat.dg/boolean_subtype.adb
Normal file
@ -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;
|
33
gcc/testsuite/gnat.dg/frame_overflow.adb
Normal file
33
gcc/testsuite/gnat.dg/frame_overflow.adb
Normal file
@ -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;
|
16
gcc/testsuite/gnat.dg/pointer_array.adb
Normal file
16
gcc/testsuite/gnat.dg/pointer_array.adb
Normal file
@ -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;
|
25
gcc/testsuite/gnat.dg/pointer_conversion.adb
Normal file
25
gcc/testsuite/gnat.dg/pointer_conversion.adb
Normal file
@ -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;
|
Loading…
Reference in New Issue
Block a user