From b5b1842549c359a16002b52b0de2b82183c1735b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 7 Jul 2006 10:26:07 +0000 Subject: [PATCH] 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 --- gcc/testsuite/ChangeLog | 10 ++++- gcc/testsuite/gnat.dg/address_conversion.adb | 24 +++++++++++ gcc/testsuite/gnat.dg/boolean_subtype.adb | 42 ++++++++++++++++++++ gcc/testsuite/gnat.dg/frame_overflow.adb | 33 +++++++++++++++ gcc/testsuite/gnat.dg/pointer_array.adb | 16 ++++++++ gcc/testsuite/gnat.dg/pointer_conversion.adb | 25 ++++++++++++ 6 files changed, 149 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/address_conversion.adb create mode 100644 gcc/testsuite/gnat.dg/boolean_subtype.adb create mode 100644 gcc/testsuite/gnat.dg/frame_overflow.adb create mode 100644 gcc/testsuite/gnat.dg/pointer_array.adb create mode 100644 gcc/testsuite/gnat.dg/pointer_conversion.adb diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 095a51ced6d..6537b287b35 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-07-07 Eric Botcazou + + * 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 PR fortran/28237 @@ -50,7 +58,7 @@ 2006-07-03 Eric Botcazou - * gnat.dg/gnat.dg/string_slice.adb: New test. + * gnat.dg/string_slice.adb: New test. 2006-07-01 Tobias Schlüter diff --git a/gcc/testsuite/gnat.dg/address_conversion.adb b/gcc/testsuite/gnat.dg/address_conversion.adb new file mode 100644 index 00000000000..5813638c46b --- /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 00000000000..3976d799233 --- /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 00000000000..4172fc013ce --- /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 00000000000..a1c72daae87 --- /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 00000000000..8ed2e0d5489 --- /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; -- 2.30.2