diff options
author | Arnaud Charlet <charlet@adacore.com> | 2008-05-20 12:49:20 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2008-05-20 14:49:20 +0200 |
commit | 73c25d9b9d65cef556afa3782c58e47422bdea0b (patch) | |
tree | 0957f58a30035b3dc84eda870fdebef4214ecbcb | |
parent | 08de96f033fdf32b2c354c4679cf34cb41194ddc (diff) | |
download | gcc-73c25d9b9d65cef556afa3782c58e47422bdea0b.zip gcc-73c25d9b9d65cef556afa3782c58e47422bdea0b.tar.gz gcc-73c25d9b9d65cef556afa3782c58e47422bdea0b.tar.bz2 |
testint.adb: New test.
* gnat.dg/testint.adb: New test.
* gnat.dg/modular1.adb: New test.
* gnat.dg/test_iface_aggr.adb: New test.
* gnat.dg/specs/tag2.ads: Adjust.
From-SVN: r135635
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/modular1.adb | 15 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/tag2.ads | 2 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/test_iface_aggr.adb | 40 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/testint.adb | 13 |
5 files changed, 76 insertions, 1 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ffbddf6..22155ec 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-05-20 Arnaud Charlet <charlet@adacore.com> + + * gnat.dg/testint.adb: New test. + * gnat.dg/modular1.adb: New test. + * gnat.dg/test_iface_aggr.adb: New test. + * gnat.dg/specs/tag2.ads: Adjust. + 2008-05-20 Richard Guenther <rguenther@suse.de> * gcc.dg/tree-ssa/ssa-sink-1.c: Adjust. diff --git a/gcc/testsuite/gnat.dg/modular1.adb b/gcc/testsuite/gnat.dg/modular1.adb new file mode 100644 index 0000000..b9fcde9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/modular1.adb @@ -0,0 +1,15 @@ +-- { dg-do run } + +with Ada.Text_IO; +procedure Modular1 is + type T1 is mod 9; + package T1_IO is new Ada.Text_IO.Modular_IO(T1); + X: T1 := 8; + J1: constant := 5; +begin for J2 in 5..5 loop + pragma Assert(X*(2**J1) = X*(2**J2)); + if X*(2**J1) /= X*(2**J2) then + raise Program_Error; + end if; + end loop; +end Modular1; diff --git a/gcc/testsuite/gnat.dg/specs/tag2.ads b/gcc/testsuite/gnat.dg/specs/tag2.ads index 8e09f25..67b4497 100644 --- a/gcc/testsuite/gnat.dg/specs/tag2.ads +++ b/gcc/testsuite/gnat.dg/specs/tag2.ads @@ -10,7 +10,7 @@ package tag2 is type T6 is tagged; protected type T1 is end T1; -- { dg-error "must be a tagged type" } task type T2; -- { dg-error "must be a tagged type" } - type T3 is null record; -- { dg-error "must be tagged" } + type T3 is null record; -- { dg-error "must be a tagged type" } task type T4 is new I with end; protected type T5 is new I with end; type T6 is tagged null record; diff --git a/gcc/testsuite/gnat.dg/test_iface_aggr.adb b/gcc/testsuite/gnat.dg/test_iface_aggr.adb new file mode 100644 index 0000000..85c1ceb --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_iface_aggr.adb @@ -0,0 +1,40 @@ +-- { dg-do run } + +with Ada.Text_IO, Ada.Tags; +procedure Test_Iface_Aggr is + package Pkg is + type Iface is interface; + function Constructor (S: Iface) return Iface'Class is abstract; + procedure Do_Test (It : Iface'class); + type Root is abstract tagged record + Comp_1 : Natural := 0; + end record; + type DT_1 is new Root and Iface with record + Comp_2, Comp_3 : Natural := 0; + end record; + function Constructor (S: DT_1) return Iface'Class; + type DT_2 is new DT_1 with null record; -- Test + function Constructor (S: DT_2) return Iface'Class; + end; + package body Pkg is + procedure Do_Test (It: in Iface'Class) is + Obj : Iface'Class := Constructor (It); + S : String := Ada.Tags.External_Tag (Obj'Tag); + begin + null; + end; + function Constructor (S: DT_1) return Iface'Class is + begin + return Iface'Class(DT_1'(others => <>)); + end; + function Constructor (S: DT_2) return Iface'Class is + Result : DT_2; + begin + return Iface'Class(DT_2'(others => <>)); -- Test + end; + end; + use Pkg; + Obj: DT_2; +begin + Do_Test (Obj); +end; diff --git a/gcc/testsuite/gnat.dg/testint.adb b/gcc/testsuite/gnat.dg/testint.adb new file mode 100644 index 0000000..a5faf4a --- /dev/null +++ b/gcc/testsuite/gnat.dg/testint.adb @@ -0,0 +1,13 @@ +-- { dg-do run } +-- { dg-options "-gnato" } + +with Text_IO; use Text_IO; +procedure testint is + function m1 (a, b : short_integer) return integer is + begin + return integer (a + b); + end m1; + f : integer; +begin + f := m1 (short_integer'Last, short_integer'Last); +end testint; |