diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-08-16 10:06:48 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-08-16 10:06:48 +0200 |
commit | 439cafcf602f14564f086fec1bf832a0c0866d7f (patch) | |
tree | 25013f00a2aa3c68380344b98ed8d3c6df971571 /gcc | |
parent | 32f56aadf5f962aeef5d91fe10fc53cc804b0490 (diff) | |
download | gcc-439cafcf602f14564f086fec1bf832a0c0866d7f.zip gcc-439cafcf602f14564f086fec1bf832a0c0866d7f.tar.gz gcc-439cafcf602f14564f086fec1bf832a0c0866d7f.tar.bz2 |
Add test cases.
From-SVN: r127533
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/testsuite/gnat.dg/addr2.adb | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/addr2_p.adb | 11 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/addr2_p.ads | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/aliased1.adb | 34 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/profile_warning.adb | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/profile_warning.ads | 6 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/profile_warning_p.adb | 20 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/profile_warning_p.ads | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/range_check.adb | 20 |
9 files changed, 119 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/addr2.adb b/gcc/testsuite/gnat.dg/addr2.adb new file mode 100644 index 0000000..15d51e3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr2.adb @@ -0,0 +1,10 @@ +-- { dg-do run } + +with addr2_p; use addr2_p; +procedure addr2 is +begin + Process (B1); + Process (Blk => B1); + Process (B2); + Process (Blk => B2); +end; diff --git a/gcc/testsuite/gnat.dg/addr2_p.adb b/gcc/testsuite/gnat.dg/addr2_p.adb new file mode 100644 index 0000000..82e151c --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr2_p.adb @@ -0,0 +1,11 @@ + +with System; +package body addr2_p is + procedure Process (Blk : Block) is + use type System.Address; + begin + if Blk'Address /= B1'Address and then Blk'Address /= B2'Address then + raise Program_Error; + end if; + end; +end; diff --git a/gcc/testsuite/gnat.dg/addr2_p.ads b/gcc/testsuite/gnat.dg/addr2_p.ads new file mode 100644 index 0000000..b85d13a --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr2_p.ads @@ -0,0 +1,10 @@ + +package addr2_p is + + type Block is array (1 .. 4) of Integer; + + procedure Process (Blk : Block); + + B1 : constant Block := Block'((1,2,3,4)); + B2 : constant Block := (1,2,3,4); +end; diff --git a/gcc/testsuite/gnat.dg/aliased1.adb b/gcc/testsuite/gnat.dg/aliased1.adb new file mode 100644 index 0000000..774ffe5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aliased1.adb @@ -0,0 +1,34 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +procedure aliased1 is + + type E is (One, Two); + + type R (D : E := One) is record + case D is + when One => + I1 : Integer; + I2 : Integer; + when Two => + B1 : Boolean; + end case; + end record; + + type Data_Type is record + Data : R; + end record; + + type Array_Type is array (Natural range <>) of Data_Type; + + function Get return Array_Type is + Ret : Array_Type (1 .. 2); + begin + return Ret; + end; + + Object : aliased Array_Type := Get; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/profile_warning.adb b/gcc/testsuite/gnat.dg/profile_warning.adb new file mode 100644 index 0000000..3bdc58e --- /dev/null +++ b/gcc/testsuite/gnat.dg/profile_warning.adb @@ -0,0 +1,4 @@ +-- { dg-do compile } + +package body profile_warning is +end; diff --git a/gcc/testsuite/gnat.dg/profile_warning.ads b/gcc/testsuite/gnat.dg/profile_warning.ads new file mode 100644 index 0000000..475d837 --- /dev/null +++ b/gcc/testsuite/gnat.dg/profile_warning.ads @@ -0,0 +1,6 @@ +pragma Profile_Warnings (Ravenscar); +with profile_warning_p; +package profile_warning is + pragma Elaborate_Body; + procedure I is new profile_warning_p.Proc; +end; diff --git a/gcc/testsuite/gnat.dg/profile_warning_p.adb b/gcc/testsuite/gnat.dg/profile_warning_p.adb new file mode 100644 index 0000000..455237a --- /dev/null +++ b/gcc/testsuite/gnat.dg/profile_warning_p.adb @@ -0,0 +1,20 @@ +package body profile_warning_p is + procedure Proc is begin null; end Proc; + + task type T is + end T; + + task body T is + begin + null; + end; + + type A_T is access T; + + procedure Do_Stuff is + P : A_T; + begin + P := new T; + end Do_Stuff; + +end; diff --git a/gcc/testsuite/gnat.dg/profile_warning_p.ads b/gcc/testsuite/gnat.dg/profile_warning_p.ads new file mode 100644 index 0000000..6c78d45 --- /dev/null +++ b/gcc/testsuite/gnat.dg/profile_warning_p.ads @@ -0,0 +1,4 @@ +package profile_warning_p is + generic + procedure Proc; +end; diff --git a/gcc/testsuite/gnat.dg/range_check.adb b/gcc/testsuite/gnat.dg/range_check.adb new file mode 100644 index 0000000..18839a1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/range_check.adb @@ -0,0 +1,20 @@ +-- { dg-do run } + +procedure range_check is + function ident (x : integer) return integer is + begin + return x; + end ident; + + guard1 : Integer; + + r : array (1 .. ident (10)) of integer; + pragma Suppress (Index_Check, r); + + guard2 : Integer; + +begin + guard1 := 0; + guard2 := 0; + r (11) := 3; +end; |