diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2006-07-07 10:26:07 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2006-07-07 10:26:07 +0000 |
commit | b5b1842549c359a16002b52b0de2b82183c1735b (patch) | |
tree | e735cfadc6bbb1d7e015f1820a2f8b5de6d37f51 /gcc | |
parent | 01ade80d07990f16adfa29a86c10b8e0dfed7b4a (diff) | |
download | gcc-b5b1842549c359a16002b52b0de2b82183c1735b.zip gcc-b5b1842549c359a16002b52b0de2b82183c1735b.tar.gz gcc-b5b1842549c359a16002b52b0de2b82183c1735b.tar.bz2 |
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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/testsuite/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/address_conversion.adb | 24 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/boolean_subtype.adb | 42 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/frame_overflow.adb | 33 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/pointer_array.adb | 16 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/pointer_conversion.adb | 25 |
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; |