From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gnat.dg/specs/abstract_limited.ads | 6 +++ gcc/testsuite/gnat.dg/specs/abstract_private.ads | 17 +++++++ gcc/testsuite/gnat.dg/specs/access3.ads | 25 ++++++++++ gcc/testsuite/gnat.dg/specs/access_constant.ads | 13 +++++ .../gnat.dg/specs/access_constant_decl.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/addr1.ads | 35 ++++++++++++++ gcc/testsuite/gnat.dg/specs/aggr1.ads | 8 ++++ gcc/testsuite/gnat.dg/specs/ai_116.ads | 23 +++++++++ gcc/testsuite/gnat.dg/specs/alignment1.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/alignment2.ads | 47 ++++++++++++++++++ gcc/testsuite/gnat.dg/specs/array_no_def_init.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/attribute_parsing.ads | 5 ++ gcc/testsuite/gnat.dg/specs/box1.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/constant1.ads | 22 +++++++++ gcc/testsuite/gnat.dg/specs/constant1_pkg.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/constructor.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/controlled1.ads | 35 ++++++++++++++ gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads | 7 +++ gcc/testsuite/gnat.dg/specs/controller.ads | 15 ++++++ gcc/testsuite/gnat.dg/specs/corr_discr.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/cpp1.ads | 10 ++++ gcc/testsuite/gnat.dg/specs/cpp_assignment.ads | 10 ++++ gcc/testsuite/gnat.dg/specs/delta_small.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/discr_private.ads | 50 +++++++++++++++++++ .../gnat.dg/specs/discr_record_constant.ads | 22 +++++++++ .../gnat.dg/specs/double_record_extension1.ads | 13 +++++ .../gnat.dg/specs/double_record_extension2.ads | 17 +++++++ gcc/testsuite/gnat.dg/specs/elab1.ads | 21 ++++++++ gcc/testsuite/gnat.dg/specs/empty_variants.ads | 32 +++++++++++++ gcc/testsuite/gnat.dg/specs/fe_inlining.ads | 4 ++ gcc/testsuite/gnat.dg/specs/fe_inlining_helper.adb | 4 ++ gcc/testsuite/gnat.dg/specs/fe_inlining_helper.ads | 3 ++ gcc/testsuite/gnat.dg/specs/formal_type.ads | 15 ++++++ gcc/testsuite/gnat.dg/specs/gen_interface.ads | 8 ++++ gcc/testsuite/gnat.dg/specs/gen_interface_p.ads | 5 ++ gcc/testsuite/gnat.dg/specs/genericppc.ads | 7 +++ gcc/testsuite/gnat.dg/specs/gnati.ads | 13 +++++ .../gnat.dg/specs/iface_eq_test-child.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/iface_eq_test.ads | 6 +++ gcc/testsuite/gnat.dg/specs/import_abstract.ads | 6 +++ gcc/testsuite/gnat.dg/specs/integer_value.ads | 5 ++ gcc/testsuite/gnat.dg/specs/interface5.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/limited1.ads | 10 ++++ gcc/testsuite/gnat.dg/specs/linker_section.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/lto3.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb | 24 ++++++++++ gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads | 26 ++++++++++ gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb | 7 +++ gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads | 20 ++++++++ gcc/testsuite/gnat.dg/specs/oconst6.ads | 18 +++++++ gcc/testsuite/gnat.dg/specs/oversize.ads | 56 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/specs/pack2.ads | 10 ++++ gcc/testsuite/gnat.dg/specs/pack3.ads | 45 +++++++++++++++++ gcc/testsuite/gnat.dg/specs/pack33.ads | 27 +++++++++++ gcc/testsuite/gnat.dg/specs/pack3_pkg.ads | 7 +++ gcc/testsuite/gnat.dg/specs/pack4.ads | 12 +++++ gcc/testsuite/gnat.dg/specs/pack5.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/pack6.ads | 24 ++++++++++ gcc/testsuite/gnat.dg/specs/pack6_pkg.ads | 17 +++++++ gcc/testsuite/gnat.dg/specs/preelab.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/private_with.ads | 16 +++++++ gcc/testsuite/gnat.dg/specs/renamings.ads | 14 ++++++ gcc/testsuite/gnat.dg/specs/rep_clause1.ads | 19 ++++++++ gcc/testsuite/gnat.dg/specs/rep_clause2.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/rep_clause3.ads | 36 ++++++++++++++ gcc/testsuite/gnat.dg/specs/rep_clause4.ads | 42 ++++++++++++++++ gcc/testsuite/gnat.dg/specs/restricted_pkg.ads | 10 ++++ .../gnat.dg/specs/root-level_1-level_2.ads | 7 +++ gcc/testsuite/gnat.dg/specs/root-level_1.ads | 14 ++++++ gcc/testsuite/gnat.dg/specs/root-level_2.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/root.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/self_class.ads | 9 ++++ gcc/testsuite/gnat.dg/specs/size_attribute1.ads | 20 ++++++++ .../gnat.dg/specs/size_attribute1_pkg1.adb | 13 +++++ .../gnat.dg/specs/size_attribute1_pkg1.ads | 15 ++++++ .../gnat.dg/specs/size_attribute1_pkg2.adb | 9 ++++ .../gnat.dg/specs/size_attribute1_pkg2.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/size_clause1.ads | 48 +++++++++++++++++++ gcc/testsuite/gnat.dg/specs/size_clause2.ads | 48 +++++++++++++++++++ gcc/testsuite/gnat.dg/specs/size_clause3.ads | 50 +++++++++++++++++++ gcc/testsuite/gnat.dg/specs/small_alignment.ads | 13 +++++ gcc/testsuite/gnat.dg/specs/specs.exp | 36 ++++++++++++++ gcc/testsuite/gnat.dg/specs/static_initializer.ads | 14 ++++++ .../gnat.dg/specs/static_initializer2.ads | 22 +++++++++ .../gnat.dg/specs/static_initializer3.ads | 29 +++++++++++ .../gnat.dg/specs/static_initializer4.ads | 13 +++++ .../gnat.dg/specs/static_initializer5.ads | 13 +++++ .../gnat.dg/specs/static_initializer5_pkg.ads | 17 +++++++ gcc/testsuite/gnat.dg/specs/storage.ads | 10 ++++ gcc/testsuite/gnat.dg/specs/sync_iface_test.ads | 14 ++++++ gcc/testsuite/gnat.dg/specs/tag1.ads | 8 ++++ gcc/testsuite/gnat.dg/specs/tag2.ads | 17 +++++++ gcc/testsuite/gnat.dg/specs/uc1.ads | 22 +++++++++ gcc/testsuite/gnat.dg/specs/unchecked_union.ads | 20 ++++++++ gcc/testsuite/gnat.dg/specs/universal_fixed.ads | 8 ++++ gcc/testsuite/gnat.dg/specs/variant_part.ads | 8 ++++ gcc/testsuite/gnat.dg/specs/varsize_return.ads | 10 ++++ .../gnat.dg/specs/varsize_return_pkg1.adb | 24 ++++++++++ .../gnat.dg/specs/varsize_return_pkg1.ads | 26 ++++++++++ .../gnat.dg/specs/varsize_return_pkg2.adb | 7 +++ .../gnat.dg/specs/varsize_return_pkg2.ads | 11 +++++ gcc/testsuite/gnat.dg/specs/warnstar.ads | 12 +++++ gcc/testsuite/gnat.dg/specs/weak1.ads | 7 +++ gcc/testsuite/gnat.dg/specs/with_containers.ads | 27 +++++++++++ 105 files changed, 1775 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/specs/abstract_limited.ads create mode 100644 gcc/testsuite/gnat.dg/specs/abstract_private.ads create mode 100644 gcc/testsuite/gnat.dg/specs/access3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/access_constant.ads create mode 100644 gcc/testsuite/gnat.dg/specs/access_constant_decl.ads create mode 100644 gcc/testsuite/gnat.dg/specs/addr1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/aggr1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/ai_116.ads create mode 100644 gcc/testsuite/gnat.dg/specs/alignment1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/alignment2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/array_no_def_init.ads create mode 100644 gcc/testsuite/gnat.dg/specs/attribute_parsing.ads create mode 100644 gcc/testsuite/gnat.dg/specs/box1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/constant1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/constant1_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/constructor.ads create mode 100644 gcc/testsuite/gnat.dg/specs/controlled1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/controller.ads create mode 100644 gcc/testsuite/gnat.dg/specs/corr_discr.ads create mode 100644 gcc/testsuite/gnat.dg/specs/cpp1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/cpp_assignment.ads create mode 100644 gcc/testsuite/gnat.dg/specs/delta_small.ads create mode 100644 gcc/testsuite/gnat.dg/specs/discr_private.ads create mode 100644 gcc/testsuite/gnat.dg/specs/discr_record_constant.ads create mode 100644 gcc/testsuite/gnat.dg/specs/double_record_extension1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/double_record_extension2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/elab1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/empty_variants.ads create mode 100644 gcc/testsuite/gnat.dg/specs/fe_inlining.ads create mode 100644 gcc/testsuite/gnat.dg/specs/fe_inlining_helper.adb create mode 100644 gcc/testsuite/gnat.dg/specs/fe_inlining_helper.ads create mode 100644 gcc/testsuite/gnat.dg/specs/formal_type.ads create mode 100644 gcc/testsuite/gnat.dg/specs/gen_interface.ads create mode 100644 gcc/testsuite/gnat.dg/specs/gen_interface_p.ads create mode 100644 gcc/testsuite/gnat.dg/specs/genericppc.ads create mode 100644 gcc/testsuite/gnat.dg/specs/gnati.ads create mode 100644 gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads create mode 100644 gcc/testsuite/gnat.dg/specs/iface_eq_test.ads create mode 100644 gcc/testsuite/gnat.dg/specs/import_abstract.ads create mode 100644 gcc/testsuite/gnat.dg/specs/integer_value.ads create mode 100644 gcc/testsuite/gnat.dg/specs/interface5.ads create mode 100644 gcc/testsuite/gnat.dg/specs/limited1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/linker_section.ads create mode 100644 gcc/testsuite/gnat.dg/specs/lto3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads create mode 100644 gcc/testsuite/gnat.dg/specs/oconst6.ads create mode 100644 gcc/testsuite/gnat.dg/specs/oversize.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack33.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack3_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack4.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack5.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack6.ads create mode 100644 gcc/testsuite/gnat.dg/specs/pack6_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/preelab.ads create mode 100644 gcc/testsuite/gnat.dg/specs/private_with.ads create mode 100644 gcc/testsuite/gnat.dg/specs/renamings.ads create mode 100644 gcc/testsuite/gnat.dg/specs/rep_clause1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/rep_clause2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/rep_clause3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/rep_clause4.ads create mode 100644 gcc/testsuite/gnat.dg/specs/restricted_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/root-level_1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/root-level_2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/root.ads create mode 100644 gcc/testsuite/gnat.dg/specs/self_class.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_attribute1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_clause1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_clause2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/size_clause3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/small_alignment.ads create mode 100644 gcc/testsuite/gnat.dg/specs/specs.exp create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer.ads create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer4.ads create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer5.ads create mode 100644 gcc/testsuite/gnat.dg/specs/static_initializer5_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/specs/storage.ads create mode 100644 gcc/testsuite/gnat.dg/specs/sync_iface_test.ads create mode 100644 gcc/testsuite/gnat.dg/specs/tag1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/tag2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/uc1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/unchecked_union.ads create mode 100644 gcc/testsuite/gnat.dg/specs/universal_fixed.ads create mode 100644 gcc/testsuite/gnat.dg/specs/variant_part.ads create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return.ads create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/warnstar.ads create mode 100644 gcc/testsuite/gnat.dg/specs/weak1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/with_containers.ads (limited to 'gcc/testsuite/gnat.dg/specs') diff --git a/gcc/testsuite/gnat.dg/specs/abstract_limited.ads b/gcc/testsuite/gnat.dg/specs/abstract_limited.ads new file mode 100644 index 000000000..adcd35249 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/abstract_limited.ads @@ -0,0 +1,6 @@ +-- { dg-do compile } + +package abstract_limited is + type I is limited interface; + type T is abstract limited new I with null record; +end; diff --git a/gcc/testsuite/gnat.dg/specs/abstract_private.ads b/gcc/testsuite/gnat.dg/specs/abstract_private.ads new file mode 100644 index 000000000..7420a9842 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/abstract_private.ads @@ -0,0 +1,17 @@ +generic +package Abstract_Private is + + type T1 is abstract tagged private; + procedure P1 (X : T1) is abstract; + + type T2 is abstract tagged private; + +private + + type T1 is abstract tagged null record; + procedure P2 (X : T1) is abstract; -- { dg-error "must be visible" } + + type T2 is abstract new T1 with null record; + procedure P1 (X : T2) is abstract; + +end Abstract_Private; diff --git a/gcc/testsuite/gnat.dg/specs/access3.ads b/gcc/testsuite/gnat.dg/specs/access3.ads new file mode 100644 index 000000000..f7fbf7e1e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/access3.ads @@ -0,0 +1,25 @@ +-- { dg-do compile } + +package access3 is + type TF is access function return access procedure (P1 : Integer); + + type TAF is access protected function return access procedure (P1 : Integer); + + type TAF2 is access + function return access protected procedure (P1 : Integer); + + type TAF3 is access + protected function return access protected procedure (P1 : Integer); + + type TAF_Inf is + access protected function return + access function return + access function return + access function return + access function return + access function return + access function return + access function return + access function return + Integer; +end access3; diff --git a/gcc/testsuite/gnat.dg/specs/access_constant.ads b/gcc/testsuite/gnat.dg/specs/access_constant.ads new file mode 100644 index 000000000..fa9829e83 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/access_constant.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } +package Access_Constant is + + c: aliased constant integer := 3; + + type const_ptr is access constant integer; + cp : const_ptr := c'access; + + procedure inc (var_ptr: access integer := + cp) -- { dg-error "access-to-constant" } + is abstract; + +end Access_Constant; diff --git a/gcc/testsuite/gnat.dg/specs/access_constant_decl.ads b/gcc/testsuite/gnat.dg/specs/access_constant_decl.ads new file mode 100644 index 000000000..aec40e6db --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/access_constant_decl.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } +package Access_Constant_Decl is + + c: aliased constant integer := 3; + + type const_ptr is access constant integer; + cp : const_ptr := c'access; + + x : access integer := cp; -- { dg-error "access-to-constant" } + +end Access_Constant_Decl; diff --git a/gcc/testsuite/gnat.dg/specs/addr1.ads b/gcc/testsuite/gnat.dg/specs/addr1.ads new file mode 100644 index 000000000..ed048f68e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/addr1.ads @@ -0,0 +1,35 @@ +-- { dg-do compile } + +with Interfaces; use Interfaces; + +package Addr1 is + + type Arr is array (Integer range <>) of Unsigned_16; + + type Rec1 is record + I1, I2: Integer; + end record; + + type Rec2 is record + I1, I2: Integer; + end record; + for Rec2'Size use 64; + + A: Arr (1 .. 4); + + Obj1: Rec1; + for Obj1'Address use A'Address; -- { dg-bogus "alignment" } + + Obj2: Rec2; + for Obj2'Address use A'Address; -- { dg-bogus "alignment" } + + Obj3: Rec1; + for Obj3'Address use A(1)'Address; -- { dg-bogus "alignment" } + + Obj4: Rec1; + for Obj4'Address use A(2)'Address; -- { dg-warning "(alignment|erroneous)" } + + Obj5: Rec1; + for Obj5'Address use A(3)'Address; -- { dg-bogus "alignment" } + +end Addr1; diff --git a/gcc/testsuite/gnat.dg/specs/aggr1.ads b/gcc/testsuite/gnat.dg/specs/aggr1.ads new file mode 100644 index 000000000..6c7663513 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/aggr1.ads @@ -0,0 +1,8 @@ +-- { dg-do compile } + +package aggr1 is + type Buffer_Array is array (1 .. 2 ** 23) of Integer; + type Message is record + Data : Buffer_Array := (others => 0); + end record; +end; diff --git a/gcc/testsuite/gnat.dg/specs/ai_116.ads b/gcc/testsuite/gnat.dg/specs/ai_116.ads new file mode 100644 index 000000000..88d7e9876 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/ai_116.ads @@ -0,0 +1,23 @@ +-- { dg-do compile } + +with Ada.Finalization; use Ada; +package ai_116 is + pragma Preelaborate; + type Buffer_Type is limited interface; + + type Handle is new Finalization.Limited_Controlled and Buffer_Type with + private; + pragma Preelaborable_Initialization(Handle); + + type Ptr is access all String; + Null_Handle : constant Handle; + +private + type Handle is new Finalization.Limited_Controlled and Buffer_Type with + record + Data : Ptr := null; + end record; + + Null_Handle : constant Handle := + (Finalization.Limited_Controlled with Data => null); +end ai_116; diff --git a/gcc/testsuite/gnat.dg/specs/alignment1.ads b/gcc/testsuite/gnat.dg/specs/alignment1.ads new file mode 100644 index 000000000..cffcba138 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/alignment1.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } + +package Alignment1 is + S : Natural := 20; + pragma Volatile (S); + + type Block is array (1 .. S) of Integer; + for Block'Alignment use 128; + + B : Block; +end; diff --git a/gcc/testsuite/gnat.dg/specs/alignment2.ads b/gcc/testsuite/gnat.dg/specs/alignment2.ads new file mode 100644 index 000000000..8dce1a8c3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/alignment2.ads @@ -0,0 +1,47 @@ +-- { dg-do compile } + +with Interfaces; use Interfaces; + +package Alignment2 is + + -- warning + type R1 is record + A, B, C, D : Integer_8; + end record; + for R1'Size use 32; + for R1'Alignment use 32; -- { dg-warning "suspiciously large alignment" } + + -- warning + type R2 is record + A, B, C, D : Integer_8; + end record; + for R2'Alignment use 32; -- { dg-warning "suspiciously large alignment" } + + -- OK, big size + type R3 is record + A, B, C, D : Integer_8; + end record; + for R3'Size use 32 * 8; + for R3'Alignment use 32; + + -- OK, big size + type R4 is record + A, B, C, D, E, F, G, H : Integer_32; + end record; + for R4'Alignment use 32; + + -- warning + type I1 is new Integer_32; + for I1'Size use 32; + for I1'Alignment use 32; -- { dg-warning "suspiciously large alignment" } + + -- warning + type I2 is new Integer_32; + for I2'Alignment use 32; -- { dg-warning "suspiciously large alignment" } + + -- OK, big size + type I3 is new Integer_32; + for I3'Size use 32 * 8; + for I3'Alignment use 32; + +end Alignment2; diff --git a/gcc/testsuite/gnat.dg/specs/array_no_def_init.ads b/gcc/testsuite/gnat.dg/specs/array_no_def_init.ads new file mode 100644 index 000000000..b7a024d6f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/array_no_def_init.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +pragma Restrictions (No_Default_Initialization); +package Array_No_Def_Init is + + type Int_Array is array (Natural range <>) of Integer; + IA : Int_Array (1 .. 10); + +end Array_No_Def_Init; diff --git a/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads b/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads new file mode 100644 index 000000000..7722a9ae1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads @@ -0,0 +1,5 @@ +-- { dg-do compile } +package Attribute_Parsing is + I : constant Integer := 12345; + S : constant String := I'Img (1 .. 2); +end Attribute_Parsing; diff --git a/gcc/testsuite/gnat.dg/specs/box1.ads b/gcc/testsuite/gnat.dg/specs/box1.ads new file mode 100644 index 000000000..dad13f332 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/box1.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package box1 is + type Root is tagged null record; + type Der1 is new Root with record + B : Boolean; + end record; + + type Der2 is new Der1 with null record; + type Der3 is new Der2 with null record; + + Obj : Der3 := (Der2 with others => <>); +end; diff --git a/gcc/testsuite/gnat.dg/specs/constant1.ads b/gcc/testsuite/gnat.dg/specs/constant1.ads new file mode 100644 index 000000000..1c00c33f7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/constant1.ads @@ -0,0 +1,22 @@ +-- { dg-do compile } + +with Constant1_Pkg; + +package Constant1 is + + type Timer_Id_T is new Constant1_Pkg.Timer_Id_T with null record; + + type Timer_Op_T (Pending : Boolean := False) is + record + case Pending is + when True => + Timer_Id : Timer_Id_T; + when False => + null; + end case; + end record; + + Timer : Timer_Op_T + := (True, Timer_Id_T'(Constant1_Pkg.Null_Timer_Id with null record)); + +end Constant1; diff --git a/gcc/testsuite/gnat.dg/specs/constant1_pkg.ads b/gcc/testsuite/gnat.dg/specs/constant1_pkg.ads new file mode 100644 index 000000000..13300b1ad --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/constant1_pkg.ads @@ -0,0 +1,11 @@ +package Constant1_Pkg is + + type Id_T is mod Natural'Last + 1; + + type Timer_Id_T is tagged record + Id : Id_T := Id_T'Last; + end record; + + Null_Timer_Id : constant Timer_Id_T := (Id => Id_T'Last - 1); + +end Constant1_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/constructor.ads b/gcc/testsuite/gnat.dg/specs/constructor.ads new file mode 100644 index 000000000..aaabc41ed --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/constructor.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package constructor is + type R (Name_Length : Natural) is record + Name : Wide_String (1..Name_Length); + Multiple : Boolean; + end record; + + Null_Params : constant R := + (Name_Length => 0, + Name => "", + Multiple => False); +end; diff --git a/gcc/testsuite/gnat.dg/specs/controlled1.ads b/gcc/testsuite/gnat.dg/specs/controlled1.ads new file mode 100644 index 000000000..1ceedaf37 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/controlled1.ads @@ -0,0 +1,35 @@ +-- { dg-do compile } + +with Ada.Finalization; +with Controlled1_Pkg; use Controlled1_Pkg; + +package Controlled1 is + + type Collection is new Ada.Finalization.Controlled with null record; + + type Object_Kind_Type is (One, Two); + + type Byte_Array is array (Natural range <>) of Integer; + + type Bounded_Byte_Array_Type is record + A : Byte_Array (1 .. Value); + end record; + + type Object_Type is tagged record + A : Bounded_Byte_Array_Type; + end record; + + type R_Object_Type is new Object_Type with record + L : Collection; + end record; + + type Obj_Type (Kind : Object_Kind_Type := One) is record + case Kind is + when One => R : R_Object_Type; + when others => null; + end case; + end record; + + type Obj_Array_Type is array (Positive range <>) of Obj_Type; + +end Controlled1; diff --git a/gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads b/gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads new file mode 100644 index 000000000..3d08c1ee9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads @@ -0,0 +1,7 @@ +-- { dg-excess-errors "no code generated" } + +package Controlled1_Pkg is + + function Value return Natural; + +end Controlled1_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/controller.ads b/gcc/testsuite/gnat.dg/specs/controller.ads new file mode 100644 index 000000000..eff9e0536 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/controller.ads @@ -0,0 +1,15 @@ +-- { dg-do compile } + +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +package Controller is + type Iface is interface; + type Thing is tagged record + Name : Unbounded_String; + end record; + type Object is abstract new Thing and Iface with private; +private + type Object is abstract new Thing and Iface + with record + Surname : Unbounded_String; + end record; +end Controller; diff --git a/gcc/testsuite/gnat.dg/specs/corr_discr.ads b/gcc/testsuite/gnat.dg/specs/corr_discr.ads new file mode 100644 index 000000000..70ea86056 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/corr_discr.ads @@ -0,0 +1,13 @@ +package Corr_Discr is + + type Base (T1 : Boolean := True; T2 : Boolean := False) + is null record; + for Base use record + T1 at 0 range 0 .. 0; + T2 at 0 range 1 .. 1; + end record; + + type Deriv (D : Boolean := False) is new Base (T1 => True, T2 => D); + +end Corr_Discr; + diff --git a/gcc/testsuite/gnat.dg/specs/cpp1.ads b/gcc/testsuite/gnat.dg/specs/cpp1.ads new file mode 100644 index 000000000..1f759b7a9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/cpp1.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +package cpp1 is + type Root_Interface is interface; + + type Typ is new Root_Interface with record + TOTO : Integer; + pragma CPP_Vtable (TOTO); + end record; +end cpp1; diff --git a/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads b/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads new file mode 100644 index 000000000..3247b671b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +package CPP_Assignment is + type T is tagged record + Data : Integer := 0; + end record; + pragma Convention (CPP, T); + + Obj1 : T := (Data => 1); Obj2 : T'Class := Obj1; +end; diff --git a/gcc/testsuite/gnat.dg/specs/delta_small.ads b/gcc/testsuite/gnat.dg/specs/delta_small.ads new file mode 100644 index 000000000..3ff742631 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/delta_small.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +package Delta_Small is + type T is delta 0.1 range -0.8 .. 0.8; + for T'Small use 0.1; + for T'Size use 4; + type T2 is new T range -0.4 .. 0.4; + for T2'Small use 0.0625; +end Delta_Small; diff --git a/gcc/testsuite/gnat.dg/specs/discr_private.ads b/gcc/testsuite/gnat.dg/specs/discr_private.ads new file mode 100644 index 000000000..0ddfbd137 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/discr_private.ads @@ -0,0 +1,50 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +package Discr_Private is + + package Dec is + type T_DECIMAL (Prec : Integer := 1) is private; + private + type T_DECIMAL (Prec : Integer := 1) is record + case Prec is + when 1 .. 2 => Value : Integer; + when others => null; + end case; + end record; + end; + + type Value_T is record + Bits : Dec.T_DECIMAL(1); + end record; + for Value_T'size use 88; + + type Value_Entry_T is record + Index : Integer; + Value : Value_T; + end record; + + type Value_Mode is (QI, HI, SI, DI, XI); + for Value_Mode'size use 8; + + type Valid_Modes_T is array (Value_Mode) of Boolean; + + type Register_T is record + Ventry : Value_Entry_T; + Vmodes : Valid_Modes_T; + end record; + + type Regid_T is (Latch, Acc); + for Regid_T use (Latch => 0, Acc => 2); + for Regid_T'Size use 8; + + type Regarray_T is array (Regid_T) of Register_T; + + type Machine_T (Up : Boolean := True) is record + case Up is + when True => Regs : Regarray_T; + when False => null; + end case; + end record; + +end Discr_Private; diff --git a/gcc/testsuite/gnat.dg/specs/discr_record_constant.ads b/gcc/testsuite/gnat.dg/specs/discr_record_constant.ads new file mode 100644 index 000000000..f43b13869 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/discr_record_constant.ads @@ -0,0 +1,22 @@ +-- { dg-do compile } + +pragma Restrictions (No_Implicit_Heap_Allocations); + +package Discr_Record_Constant is + + type T (Big : Boolean := False) is record + case Big is + when True => + Content : Integer; + when False => + null; + end case; + end record; + + D : constant T := (True, 0); + + Var : T := D; -- OK, maximum size + Con : constant T := D; -- Violation of restriction + Ter : constant T := Con; -- Violation of restriction + +end Discr_Record_Constant; diff --git a/gcc/testsuite/gnat.dg/specs/double_record_extension1.ads b/gcc/testsuite/gnat.dg/specs/double_record_extension1.ads new file mode 100644 index 000000000..c1c436f3e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/double_record_extension1.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package double_record_extension1 is + + type T1(n: natural) is tagged record + s1: string (1..n); + end record; + type T2(j,k: natural) is new T1(j) with record + s2: string (1..k); + end record; + type T3 is new T2 (10, 10) with null record; + +end double_record_extension1; diff --git a/gcc/testsuite/gnat.dg/specs/double_record_extension2.ads b/gcc/testsuite/gnat.dg/specs/double_record_extension2.ads new file mode 100644 index 000000000..8fa83dbce --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/double_record_extension2.ads @@ -0,0 +1,17 @@ +-- { dg-do compile } + +package double_record_extension2 is + + type Base_Message_Type (Num_Bytes : Positive) is tagged record + Data_Block : String (1..Num_Bytes); + end record; + + type Extended_Message_Type (Num_Bytes1 : Positive; Num_Bytes2 : Positive) is new Base_Message_Type (Num_Bytes1) with record + A: String (1..Num_Bytes2); + end record; + + type Final_Message_Type is new Extended_Message_Type with record + B : Integer; + end record; + +end double_record_extension2; diff --git a/gcc/testsuite/gnat.dg/specs/elab1.ads b/gcc/testsuite/gnat.dg/specs/elab1.ads new file mode 100644 index 000000000..ac435d76a --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/elab1.ads @@ -0,0 +1,21 @@ +-- { dg-do compile } + +pragma Restrictions(No_Elaboration_Code); + +with System; + +package Elab1 is + + type Ptrs_Type is array (Integer range 1 .. 2) of System.Address; + type Vars_Array is array (Integer range 1 .. 2) of Integer; + + Vars : Vars_Array; + + Val1 : constant Integer := 1; + Val2 : constant Integer := 2; + + Ptrs : constant Ptrs_Type := + (1 => Vars (Val1)'Address, + 2 => Vars (Val2)'Address); + +end Elab1; diff --git a/gcc/testsuite/gnat.dg/specs/empty_variants.ads b/gcc/testsuite/gnat.dg/specs/empty_variants.ads new file mode 100644 index 000000000..079b64ac8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/empty_variants.ads @@ -0,0 +1,32 @@ +-- { dg-do compile } +-- { dg-options "-gnatdF" } + +package Empty_Variants is + + type Rec (D : Integer := 1) is record + case D is + when 1 => + I : Integer; + when 2 .. 5 => + J : Integer; + K : Integer; + when 6 => + null; + when 7 .. 8 => + null; + when others => + L : Integer; + M : Integer; + N : Integer; + end case; + end record; + + R : Rec; + + I : Integer := R.I; + J : Integer := R.J; + K : Integer := R.K; + L : Integer := R.L; + M : Integer := R.L; + +end Empty_Variants; diff --git a/gcc/testsuite/gnat.dg/specs/fe_inlining.ads b/gcc/testsuite/gnat.dg/specs/fe_inlining.ads new file mode 100644 index 000000000..ef5f46942 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/fe_inlining.ads @@ -0,0 +1,4 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatN" } +with FE_Inlining_Helper; +procedure FE_Inlining is new FE_Inlining_Helper; diff --git a/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.adb b/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.adb new file mode 100644 index 000000000..c149ea3c7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.adb @@ -0,0 +1,4 @@ +procedure FE_Inlining_Helper is +begin + null; +end FE_Inlining_Helper; diff --git a/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.ads b/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.ads new file mode 100644 index 000000000..733268c65 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/fe_inlining_helper.ads @@ -0,0 +1,3 @@ +-- { dg-excess-errors "no code generated" } +generic +procedure FE_Inlining_Helper; diff --git a/gcc/testsuite/gnat.dg/specs/formal_type.ads b/gcc/testsuite/gnat.dg/specs/formal_type.ads new file mode 100644 index 000000000..4f12b82d3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/formal_type.ads @@ -0,0 +1,15 @@ +-- { dg-do compile } + +with Ada.Strings.Bounded; +package formal_type is + generic + with package BI is + new Ada.Strings.Bounded.Generic_Bounded_Length (<>); + type NB is new BI.Bounded_String; + package G is end; + package BI is new Ada.Strings.Bounded.Generic_Bounded_Length (30); + type NB is new BI.Bounded_String; + Thing : NB; + Size : Integer := THing.Max_Length; + package GI is new G (BI, NB); +end; diff --git a/gcc/testsuite/gnat.dg/specs/gen_interface.ads b/gcc/testsuite/gnat.dg/specs/gen_interface.ads new file mode 100644 index 000000000..9ec902d42 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/gen_interface.ads @@ -0,0 +1,8 @@ +-- { dg-do compile } + +with gen_interface_p; +package gen_interface is + type T is interface; + procedure P (Thing: T) is abstract; + package NG is new gen_interface_p (T, P); +end; diff --git a/gcc/testsuite/gnat.dg/specs/gen_interface_p.ads b/gcc/testsuite/gnat.dg/specs/gen_interface_p.ads new file mode 100644 index 000000000..5ebceb253 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/gen_interface_p.ads @@ -0,0 +1,5 @@ +generic + type I is interface; + with procedure P (X : I) is abstract; +package gen_interface_p is +end; diff --git a/gcc/testsuite/gnat.dg/specs/genericppc.ads b/gcc/testsuite/gnat.dg/specs/genericppc.ads new file mode 100644 index 000000000..494a8890b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/genericppc.ads @@ -0,0 +1,7 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } + +generic + type T_Item is private; +function genericppc (T : in t_Item; I : integer) return integer; +pragma Precondition (I > 0); diff --git a/gcc/testsuite/gnat.dg/specs/gnati.ads b/gcc/testsuite/gnat.dg/specs/gnati.ads new file mode 100644 index 000000000..72eff6e2e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/gnati.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } +-- { dg-options "-gnatI" } + +package gnati is + type j is range 1 .. 50; + for j'size use 1; + type n is new integer; + for n'alignment use -99; + type e is (a, b); + for e use (1, 1); + type r is record x : integer; end record; + for r use record x at 0 range 0 .. 0; end record; +end gnati; diff --git a/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads b/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads new file mode 100644 index 000000000..028bb1be0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } +generic +package Iface_Eq_Test.Child is + protected type PO is new Iface with + procedure Dummy; + end; + overriding function "=" (L, R : access PO) return Boolean; +end; diff --git a/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads b/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads new file mode 100644 index 000000000..36f9031ad --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads @@ -0,0 +1,6 @@ +-- { dg-do compile } +generic +package Iface_Eq_Test is + type Iface is limited interface; + function "=" (L, R : access Iface) return Boolean is abstract; +end; diff --git a/gcc/testsuite/gnat.dg/specs/import_abstract.ads b/gcc/testsuite/gnat.dg/specs/import_abstract.ads new file mode 100644 index 000000000..9d05f0c1c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/import_abstract.ads @@ -0,0 +1,6 @@ +-- { dg-do compile } +package Import_Abstract is + type T1 is abstract tagged null record; + procedure p1(X : T1) is abstract; + pragma Import (Ada, p1); -- { dg-error "cannot import abstract subprogram" } +end Import_Abstract; diff --git a/gcc/testsuite/gnat.dg/specs/integer_value.ads b/gcc/testsuite/gnat.dg/specs/integer_value.ads new file mode 100644 index 000000000..6e9c1b51f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/integer_value.ads @@ -0,0 +1,5 @@ +-- { dg-do compile } +package Integer_Value is + X : constant Integer := + Integer'Integer_Value (12.8); -- { dg-error "fixed-point type" "" } +end Integer_Value; diff --git a/gcc/testsuite/gnat.dg/specs/interface5.ads b/gcc/testsuite/gnat.dg/specs/interface5.ads new file mode 100644 index 000000000..842b5e3fe --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/interface5.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } + +package interface5 is + type Lim_Iface is limited interface; + protected type Prot_Typ is new Lim_Iface with + private + end Prot_Typ; +end interface5; diff --git a/gcc/testsuite/gnat.dg/specs/limited1.ads b/gcc/testsuite/gnat.dg/specs/limited1.ads new file mode 100644 index 000000000..375cf66f5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited1.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +package limited1 is + pragma Pure; + + type Buffer is limited interface; + type Synchronous_Buffer_Type is synchronized interface and Buffer; + +private +end limited1; diff --git a/gcc/testsuite/gnat.dg/specs/linker_section.ads b/gcc/testsuite/gnat.dg/specs/linker_section.ads new file mode 100644 index 000000000..73e89aa48 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/linker_section.ads @@ -0,0 +1,13 @@ +package Linker_Section is + Data1 : constant String := "12345678901234567"; + pragma Linker_Section (Entity => Data1, + Section => ".eeprom"); + type EEPROM_String is new String; + pragma Linker_Section (Entity => EEPROM_String, -- { dg-error "objects" } + Section => ".eeprom"); + Data2 : constant EEPROM_String := "12345678901234567"; + package Inner is end; + pragma Linker_Section (Entity => Inner, -- { dg-error "objects" } + Section => ".eeprom"); +end Linker_Section; + diff --git a/gcc/testsuite/gnat.dg/specs/lto3.ads b/gcc/testsuite/gnat.dg/specs/lto3.ads new file mode 100644 index 000000000..9576376f2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/lto3.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } +-- { dg-options "-gnatws -flto" { target lto } } + +with Lto3_Pkg1; + +package Lto3 is + + package P is new Lto3_Pkg1 (Id_T => Natural); + +end Lto3; diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb new file mode 100644 index 000000000..34caa3c6c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb @@ -0,0 +1,24 @@ +package body Lto3_Pkg1 is + + function Is_Fixed return Boolean is + begin + return True; + end Is_Fixed; + + function Do_Item (I : Natural) return Variable_Data_Fixed_T is + It : Variable_Data_Fixed_T; + begin + return It; + end Do_Item; + + My_Db : Db.T; + + procedure Run is + Kitem : Variable_Data_Fixed_T; + I : Natural; + begin + Kitem := Db.Get (My_Db); + Kitem := Do_Item (I); + end Run; + +end Lto3_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads new file mode 100644 index 000000000..5619b60c7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads @@ -0,0 +1,26 @@ +-- { dg-excess-errors "no code generated" } + +with Lto3_Pkg2; + +generic + type Id_T is range <>; +package Lto3_Pkg1 is + + type Variable_Data_T (Fixed : Boolean := False) is + record + case Fixed is + when True => + Length : Natural; + when False => + null; + end case; + end record; + + function Is_Fixed return Boolean; + + type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed); + + package Db is new Lto3_Pkg2 (Id_T => Id_T, + Data_T => Variable_Data_Fixed_T); + +end Lto3_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb new file mode 100644 index 000000000..d95fe60dd --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb @@ -0,0 +1,7 @@ +package body Lto3_Pkg2 is + function Get (X : T) return Data_T is + Result : Data_T; + begin + return Result; + end; +end Lto3_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads new file mode 100644 index 000000000..52fdccb90 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads @@ -0,0 +1,11 @@ +-- { dg-excess-errors "no code generated" } + +generic + type Id_T is private; + type Data_T is private; +package Lto3_Pkg2 is + type T is private; + function Get (X : T) return Data_T; +private + type T is null record; +end Lto3_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads b/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads new file mode 100644 index 000000000..95467f428 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads @@ -0,0 +1,20 @@ +-- { dg-do compile } +package Null_Aggr_Bug is + + type Rec1 is null record; + + type Rec2 is tagged null record; + + type Rec3 is new Rec2 with null record; + + X1 : Rec1 := (null record); + Y1 : Rec1 := (others => <>); + + X2 : Rec2 := (null record); + Y2 : Rec2 := (others => <>); + + X3 : Rec3 := (null record); + Y3 : Rec3 := (others => <>); + Z3 : Rec3 := (Rec2 with others => <>); + +end Null_Aggr_Bug; diff --git a/gcc/testsuite/gnat.dg/specs/oconst6.ads b/gcc/testsuite/gnat.dg/specs/oconst6.ads new file mode 100644 index 000000000..e4c3c50eb --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/oconst6.ads @@ -0,0 +1,18 @@ +-- { dg-do compile } +-- { dg-final { scan-assembler-not "elabs" } } + +package OCONST6 is + + type Sequence is array (1 .. 1) of Natural; + + type Message is record + Data : Sequence; + end record; + + for Message'Alignment use 1; + pragma PACK (Message); + + ACK : Message := (Data => (others => 1)); + +end; + diff --git a/gcc/testsuite/gnat.dg/specs/oversize.ads b/gcc/testsuite/gnat.dg/specs/oversize.ads new file mode 100644 index 000000000..e98c8bd77 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/oversize.ads @@ -0,0 +1,56 @@ +with Ada.Numerics.Discrete_Random; + +package Oversize is + + subtype M1 is Integer range 1 .. 200; -- Won't trigger + type R1 (D : M1 := 100) is record + Name : String (1 .. D); + end record; + + type M2 is new Integer range 1 .. 200; -- Won't trigger + for M2'Size use 64; + type M2S is array (M2 range <>) of Character; + type R2 (D : M2 := 100) is record + Name : M2S (1 .. D); + end record; + + subtype M3 is Integer; -- Will trigger + type R3 (D : M3 := 100) -- { dg-error "may raise Storage_Error" } + is record + Name : String (1 .. D); + end record; + + type M4 is new Positive; -- Will trigger + type M4S is array (M4 range <>) of Character; + type R4 (D : M4 := 100) -- { dg-error "may raise Storage_Error" } + is record + Name : M4S (1 .. D); + end record; + + type M5 is new Positive; -- Will trigger + for M5'Size use Integer'Size - 1; + type M5S is array (M5 range <>) of Character; + type R5 (D : M5 := 100) -- { dg-error "may raise Storage_Error" } + is record + Name : M5S (1 .. D); + end record; + + subtype M6 is Integer range 1 .. (Integer'Last + 1)/2; -- Won't trigger + type R6 (D : M6 := 100) is record + Name : String (1 .. D); + end record; + + subtype M7 is Integer range 1 .. (Integer'Last + 1)/2+1; -- Will trigger + type R7 (D : M7 := 100) -- { dg-error "may raise Storage_Error" } + is record + Name : String (1 .. D); + end record; + + package P8 is new Ada.Numerics.Discrete_Random (Natural); + G8 : P8.Generator; + subtype M8 is Integer range 1 .. P8.Random (G8); -- Won't trigger + type R8 (D : M8 := 100) is record + Name : String (1 .. D); + end record; + +end Oversize; diff --git a/gcc/testsuite/gnat.dg/specs/pack2.ads b/gcc/testsuite/gnat.dg/specs/pack2.ads new file mode 100644 index 000000000..7272048a1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack2.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +package Pack2 is + type Rec is record + Ptr: access Character; + Int :Integer; + end record; + type Table is array (1..2) of rec; + pragma Pack (Table); +end Pack2; diff --git a/gcc/testsuite/gnat.dg/specs/pack3.ads b/gcc/testsuite/gnat.dg/specs/pack3.ads new file mode 100644 index 000000000..ba2b34683 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack3.ads @@ -0,0 +1,45 @@ +-- { dg-do compile } + +with Pack3_Pkg; + +package Pack3 is + + subtype N_TYPE is INTEGER range 0..5; + + type LIST_ARRAY is array (N_TYPE range <>) of INTEGER; + + type LIST (N : N_TYPE := 0) is record + LIST : LIST_ARRAY(1..N); + end record; + pragma PACK(LIST); + + subtype CS is STRING(1..Pack3_Pkg.F); + + type CSA is array (NATURAL range <>) of CS; + + type REC is record + I1, I2 : INTEGER; + end record ; + + type CMD is (CO, AS); + + type CMD_BLOCK_TYPE (D : CMD := CO) is record + N : CSA (1..4); + case D is + when CO => L : LIST; + when AS => R : REC; + end case ; + end record; + pragma PACK(CMD_BLOCK_TYPE); + + type CMD_TYPE is (RIGHT, WRONG); + + type CMD_RESULT (D : CMD_TYPE) is record + case D is + when RIGHT => C : CMD_BLOCK_TYPE; + when WRONG => null; + end case; + end record ; + pragma PACK(CMD_RESULT); + +end Pack3; diff --git a/gcc/testsuite/gnat.dg/specs/pack33.ads b/gcc/testsuite/gnat.dg/specs/pack33.ads new file mode 100644 index 000000000..d5255aa44 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack33.ads @@ -0,0 +1,27 @@ +-- { dg-do compile } + +package Pack33 is + + Bits : constant := 33; + + type Bits_33 is mod 2 ** Bits; + for Bits_33'Size use Bits; + + type Cluster is record + E0, E1, E2, E3, E4, E5, E6, E7 : Bits_33; + end record; + + for Cluster use record + E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1; + E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1; + E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1; + E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1; + E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1; + E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1; + E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1; + E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1; + end record; + + for Cluster'Size use Bits * 8; + +end Pack33; diff --git a/gcc/testsuite/gnat.dg/specs/pack3_pkg.ads b/gcc/testsuite/gnat.dg/specs/pack3_pkg.ads new file mode 100644 index 000000000..200333188 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack3_pkg.ads @@ -0,0 +1,7 @@ +-- { dg-excess-errors "no code generated" } + +package Pack3_Pkg is + + function F return Integer; + +end Pack3_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/pack4.ads b/gcc/testsuite/gnat.dg/specs/pack4.ads new file mode 100644 index 000000000..82b76d2f4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack4.ads @@ -0,0 +1,12 @@ +package Pack4 is + + type Buffer is array (Natural range <>) of Boolean; + + type Root (Size : Natural) is tagged record + Data : Buffer (1..Size); + end record; + pragma Pack (Root); + + type Derived is new Root with null record; + +end Pack4; diff --git a/gcc/testsuite/gnat.dg/specs/pack5.ads b/gcc/testsuite/gnat.dg/specs/pack5.ads new file mode 100644 index 000000000..65c8fc744 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack5.ads @@ -0,0 +1,13 @@ +package Pack5 is + + type Small is range -32 .. 31; + + type Arr is array (Integer range <>) of Small; + pragma Pack (Arr); + + type Rec is record + Y: Arr (1 .. 10); + end record; + pragma Pack (Rec); + +end Pack5; diff --git a/gcc/testsuite/gnat.dg/specs/pack6.ads b/gcc/testsuite/gnat.dg/specs/pack6.ads new file mode 100644 index 000000000..cf1813d14 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack6.ads @@ -0,0 +1,24 @@ +-- { dg-do compile } + +with Ada.Finalization; +with Pack6_Pkg; + +package Pack6 is + + package Eight_Bits is new Pack6_Pkg (8); + + type Some_Data is record + Byte_1 : Eight_Bits.Object; + Byte_2 : Eight_Bits.Object; + end record; + + for Some_Data use record + Byte_1 at 0 range 0 .. 7; + Byte_2 at 1 range 0 .. 7; + end record; + + type Top_Object is new Ada.Finalization.Controlled with record + Data : Some_Data; + end record; + +end Pack6; diff --git a/gcc/testsuite/gnat.dg/specs/pack6_pkg.ads b/gcc/testsuite/gnat.dg/specs/pack6_pkg.ads new file mode 100644 index 000000000..52ded342d --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack6_pkg.ads @@ -0,0 +1,17 @@ +generic + + Size : Positive; + +package Pack6_Pkg is + + type Object is private; + +private + + type Bit is range 0 .. 1; + for Bit'Size use 1; + + type Object is array (1 .. Size) of Bit; + pragma Pack (Object); + +end Pack6_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/preelab.ads b/gcc/testsuite/gnat.dg/specs/preelab.ads new file mode 100644 index 000000000..4336c754f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/preelab.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with Ada.Finalization; +package preelab is + type T is limited private; + pragma Preelaborable_Initialization (T); +private + type T is new Ada.Finalization.Limited_Controlled with null record; +end preelab; diff --git a/gcc/testsuite/gnat.dg/specs/private_with.ads b/gcc/testsuite/gnat.dg/specs/private_with.ads new file mode 100644 index 000000000..f339e5a43 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/private_with.ads @@ -0,0 +1,16 @@ +-- { dg-do compile } + +private with Ada.Containers.Ordered_Maps; +with Ada.Containers.Ordered_Sets; +with Ada.Unchecked_Deallocation; +package private_with is + + type String_Access is access String; + + package Index_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Positive); + + procedure Free is new Ada.Unchecked_Deallocation + (Object => String, + Name => String_Access); +end; diff --git a/gcc/testsuite/gnat.dg/specs/renamings.ads b/gcc/testsuite/gnat.dg/specs/renamings.ads new file mode 100644 index 000000000..745795299 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renamings.ads @@ -0,0 +1,14 @@ +package Renamings is + + package Inner is + procedure PI (X : Integer); + end Inner; + + procedure P (X : Integer) renames Inner.PI; + procedure P (X : Float); + pragma Convention (C, P); -- { dg-error "non-local entity" } + + procedure Q (X : Float); + procedure Q (X : Integer) renames Inner.PI; + pragma Convention (C, Q); -- { dg-error "non-local entity" } +end Renamings; diff --git a/gcc/testsuite/gnat.dg/specs/rep_clause1.ads b/gcc/testsuite/gnat.dg/specs/rep_clause1.ads new file mode 100644 index 000000000..57f63ad3b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/rep_clause1.ads @@ -0,0 +1,19 @@ +-- { dg-do compile } +-- { dg-options "-gnatwa" } + +package Rep_Clause1 is + generic + type Custom_T is private; + package Handler is + type Storage_T is record + A : Boolean; + B : Boolean; + C : Custom_T; + end record; + + for Storage_T use record + A at 0 range 0..0; + B at 1 range 0..0; + end record; + end Handler; +end Rep_Clause1; diff --git a/gcc/testsuite/gnat.dg/specs/rep_clause2.ads b/gcc/testsuite/gnat.dg/specs/rep_clause2.ads new file mode 100644 index 000000000..361c141ec --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/rep_clause2.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +package Rep_Clause2 is + + type S is new String; + for S'Component_Size use 256; + + type T is new S(1..8); + +end Rep_Clause2; diff --git a/gcc/testsuite/gnat.dg/specs/rep_clause3.ads b/gcc/testsuite/gnat.dg/specs/rep_clause3.ads new file mode 100644 index 000000000..438c60468 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/rep_clause3.ads @@ -0,0 +1,36 @@ +package Rep_Clause3 is + + type Record1 is + record + Page_Handle : Integer range 0 .. 255; + Page_Owner : Integer range 0 .. 15; + end record; + for Record1 use + record + Page_Handle at 0 range 0 .. 15; + Page_Owner at 0 range 16 .. 19; + end record; + for Record1'Size use 20; + + type Range_A is range 1 .. 7; + for Range_A'Size use 16; + + type Array_Type is array (Range_A) of Record1; + pragma Pack (Array_Type); + for Array_Type'Size use 7 * 20; +-- for array_Type'alignment use 1; + + type Record2 is + record + Page_Tree_Index : Range_A; + Page_Tree : Array_Type; + end record; + + for Record2 use + record + Page_Tree_Index at 0 range 0 .. 15; + Page_Tree at 0 range 16 .. 15 + (7 * 20); + end record; + for Record2'Size use 16 + (7 * 20); + +end Rep_Clause3; diff --git a/gcc/testsuite/gnat.dg/specs/rep_clause4.ads b/gcc/testsuite/gnat.dg/specs/rep_clause4.ads new file mode 100644 index 000000000..8009f876c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/rep_clause4.ads @@ -0,0 +1,42 @@ +-- { dg-do compile } +-- { dg-options "-O" } + +package Rep_Clause4 is + + type Uns16 is mod 2**16; + + type Rec32 is + record + W1 : Uns16 := 1; + W2 : Uns16 := 2; + end record; + for Rec32 use + record + W1 at 0 range 0..15; + W2 at 2 range 0..15; + end record; + for Rec32'size use 32; + + type Rec48 is + record + W1andW2 : Rec32; + W3 : Uns16; + end record; + for Rec48 use + record + W1andW2 at 0 range 0..31; + W3 at 4 range 0..15; + end record; + for Rec48'size use 48; + + type Rec_Type is + record + Field1 : Rec48; + end record; + for Rec_Type use + record + Field1 at 0 range 0 .. 47; + end record; + for Rec_Type'size use 48; + +end Rep_Clause4; diff --git a/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads b/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads new file mode 100644 index 000000000..cfd846994 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/restricted_pkg.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } + +pragma Restrictions (No_Entry_Queue); +package Restricted_Pkg is + type Iface is limited interface; + protected type PO is new Iface with + procedure Dummy; + end; +end; diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads new file mode 100644 index 000000000..9687208e0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads @@ -0,0 +1,7 @@ +package Root.Level_1.Level_2 is + + type Level_2_Type (First : Natural; + Second : Natural) is new + Level_1.Level_1_Type (First => First, Second => Second) with null record; + +end Root.Level_1.Level_2; diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1.ads b/gcc/testsuite/gnat.dg/specs/root-level_1.ads new file mode 100644 index 000000000..6bcb1251f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_1.ads @@ -0,0 +1,14 @@ +package Root.Level_1 is + + type Level_1_Type (First : Natural; + Second : Natural) is new Root_Type with private; + +private + + type Level_1_Type (First : Natural; + Second : Natural) is new Root_Type (First => First) + with record + Buffer_1 : Buffer_Type (1 .. Second); + end record; + +end Root.Level_1; diff --git a/gcc/testsuite/gnat.dg/specs/root-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_2.ads new file mode 100644 index 000000000..c4f812ecf --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_2.ads @@ -0,0 +1,9 @@ +with Root.Level_1; + +package Root.Level_2 is + + type Level_2_Type (First : Natural; + Second : Natural) is new + Level_1.Level_1_Type (First => First, Second => Second) with null record; + +end Root.Level_2; diff --git a/gcc/testsuite/gnat.dg/specs/root.ads b/gcc/testsuite/gnat.dg/specs/root.ads new file mode 100644 index 000000000..e80ab8804 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root.ads @@ -0,0 +1,9 @@ +package Root is + + type Buffer_Type is array (Positive range <>) of Natural; + + type Root_Type (First : Natural) is abstract tagged record + Buffer_Root : Buffer_Type (1 .. First); + end record; + +end Root; diff --git a/gcc/testsuite/gnat.dg/specs/self_class.ads b/gcc/testsuite/gnat.dg/specs/self_class.ads new file mode 100644 index 000000000..56c7ab476 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/self_class.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +package Self_Class is + type P6 is private; +private + type P6 is tagged record + Self : access P6'Class; + end record; +end Self_Class; diff --git a/gcc/testsuite/gnat.dg/specs/size_attribute1.ads b/gcc/testsuite/gnat.dg/specs/size_attribute1.ads new file mode 100644 index 000000000..ece680728 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_attribute1.ads @@ -0,0 +1,20 @@ +-- { dg-do compile } + +with Size_Attribute1_Pkg1; + +package Size_Attribute1 is + + function Num return Natural; + pragma Import (Ada, Num); + + type A is array (Natural range <>) of Integer; + + type T is + record + F1 : Long_Float; + F2 : A (1 .. Num); + end record; + + package My_Q is new Size_Attribute1_Pkg1 (T); + +end Size_Attribute1; diff --git a/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.adb b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.adb new file mode 100644 index 000000000..a0a45a9e4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.adb @@ -0,0 +1,13 @@ +package body Size_Attribute1_Pkg1 is + + type Rec is + record + F : T; + end record; + + procedure Dummy is + begin + null; + end; + +end Size_Attribute1_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.ads b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.ads new file mode 100644 index 000000000..2cd2dc4d1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg1.ads @@ -0,0 +1,15 @@ +-- { dg-excess-errors "no code generated" } + +with Size_Attribute1_Pkg2; + +generic + + type T is private; + +package Size_Attribute1_Pkg1 is + + package My_R is new Size_Attribute1_Pkg2 (T); + + procedure Dummy; + +end Size_Attribute1_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.adb b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.adb new file mode 100644 index 000000000..ded1c8c65 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.adb @@ -0,0 +1,9 @@ +package body Size_Attribute1_Pkg2 is + + procedure Proc is + I : Integer := T'Size; + begin + null; + end; + +end Size_Attribute1_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.ads b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.ads new file mode 100644 index 000000000..156150803 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_attribute1_pkg2.ads @@ -0,0 +1,11 @@ +-- { dg-excess-errors "no code generated" } + +generic + + type T is private; + +package Size_Attribute1_Pkg2 is + + procedure Proc; + +end Size_Attribute1_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/size_clause1.ads b/gcc/testsuite/gnat.dg/specs/size_clause1.ads new file mode 100644 index 000000000..5b8417ea7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_clause1.ads @@ -0,0 +1,48 @@ +-- { dg-do compile } + +package Size_Clause1 is + + -- The record inherits the alignment of Integer, which is 4, so + -- the real size is 64 instead of 40. That's OK, as long as the + -- size of a component of type R1 in a packed record is 40. + type R1 is record + I : Integer; + B : Boolean; + end record; + for R1'Size use 40; + + type S1 is record + rr : R1; -- size must be 40 + end record; + pragma Pack(S1); + + -- The record is explicitly given alignment 1 so its real type is 40 too. + -- The size of a component of type R2 in a packed record is naturally 40. + type R2 is record + I : Integer; + B : Boolean; + end record; + for R2'Size use 40; + for R2'Alignment use 1; + + type S2 is record + rr : R2; -- size must be 40 + end record; + pragma Pack(S2); + + -- The record is explicitly given alignment 4 so its real type is 64. + -- That's OK, as long as the size of a component of type R3 in a packed + -- record is 40. + type R3 is record + I : Integer; + B : Boolean; + end record; + for R3'Size use 40; + for R3'Alignment use 4; + + type S3 is record + rr : R3; -- size must be 40 + end record; + pragma Pack(S3); + +end Size_Clause1; diff --git a/gcc/testsuite/gnat.dg/specs/size_clause2.ads b/gcc/testsuite/gnat.dg/specs/size_clause2.ads new file mode 100644 index 000000000..957d3920f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_clause2.ads @@ -0,0 +1,48 @@ +-- { dg-do compile } + +package Size_Clause2 is + + -- The alignment of the record is capped to the greatest power of 2 + -- factor of the size, so that the real size is 40 too and the size + -- of a component of type R1 in a packed record can be 40. + type R1 is record + I : Integer; + B : aliased Boolean; + end record; + for R1'Size use 40; + + type S1 is record + rr : R1; -- size must be 40 + end record; + pragma Pack(S1); + + -- The record is explicitly given alignment 1 so its real type is 40 too. + -- The size of a component of type R2 in a packed record is naturally 40. + type R2 is record + I : Integer; + B : aliased Boolean; + end record; + for R2'Size use 40; + for R2'Alignment use 1; + + type S2 is record + rr : R2; -- size must be 40 + end record; + pragma Pack(S2); + + -- The record is explicitly given alignment 4 so its real type is 64. + -- That's not OK, because the size of a component of type R3 in a packed + -- record cannot be 40 so the size clause is violated. + type R3 is record + I : Integer; + B : aliased Boolean; + end record; + for R3'Size use 40; -- { dg-error "size for .R3. too small" } + for R3'Alignment use 4; + + type S3 is record + rr : R3; -- size must be 40 + end record; + pragma Pack(S3); + +end Size_Clause2; diff --git a/gcc/testsuite/gnat.dg/specs/size_clause3.ads b/gcc/testsuite/gnat.dg/specs/size_clause3.ads new file mode 100644 index 000000000..6a89114e4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/size_clause3.ads @@ -0,0 +1,50 @@ +-- { dg-do compile } + +package Size_Clause3 is + + -- The record inherits the alignment of Integer, which is 4, so + -- the real size is 64 instead of 40. + type R1 is record + I : Integer; + B : aliased Boolean; + end record; + + -- That's not OK, the size of a component of type R1 cannot be 40. + type S1 is record + rr : R1; -- size must be 40 + end record; + for S1 use record + rr at 0 range 0 .. 39; -- { dg-error "size of .rr. with aliased or tagged component" } + end record; + + -- The record is explicitly given alignment 1 so its real type is 40. + type R2 is record + I : Integer; + B : aliased Boolean; + end record; + for R2'Alignment use 1; + + -- That's OK, the size of a component of type R2 can be 40. + type S2 is record + rr : R2; -- size must be 40 + end record; + for S2 use record + rr at 0 range 0 .. 39; + end record; + + -- The record is explicitly given alignment 4 so its real type is 64. + type R3 is record + I : Integer; + B : aliased Boolean; + end record; + for R3'Alignment use 4; + + -- That's not OK, the size of a component of type R3 cannot be 40. + type S3 is record + rr : R3; -- size must be 40 + end record; + for S3 use record + rr at 0 range 0 .. 39; -- { dg-error "size of .rr. with aliased or tagged component" } + end record; + +end Size_Clause3; diff --git a/gcc/testsuite/gnat.dg/specs/small_alignment.ads b/gcc/testsuite/gnat.dg/specs/small_alignment.ads new file mode 100644 index 000000000..fbedf47d1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/small_alignment.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package Small_Alignment is + + type Int is range -512 .. 511; + for Int'Alignment use 1; + + type R is record + I: Int; + end record; + Pragma Pack (R); + +end Small_Alignment; diff --git a/gcc/testsuite/gnat.dg/specs/specs.exp b/gcc/testsuite/gnat.dg/specs/specs.exp new file mode 100644 index 000000000..91c5f6c4c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/specs.exp @@ -0,0 +1,36 @@ +# Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# GCC testsuite that uses the `dg.exp' driver. + +# Load support procs. +load_lib gnat-dg.exp + +# If a testcase doesn't have special options, use these. +global DEFAULT_CFLAGS +if ![info exists DEFAULT_CFLAGS] then { + set DEFAULT_CFLAGS "" +} + +# Initialize `dg'. +dg-init + +# Main loop. +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.ads]] \ + "" $DEFAULT_CFLAGS + +# All done. +dg-finish diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer.ads b/gcc/testsuite/gnat.dg/specs/static_initializer.ads new file mode 100644 index 000000000..8755c30d1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer.ads @@ -0,0 +1,14 @@ +-- { dg-do compile } + +package static_initializer is + + type Vector is array (1 .. 3) of Float; + type Arr is array (Integer range 1 .. 3) of Vector; + + Pos : constant Arr := ((0.0, 1.0, 2.0), + (0.5, 1.5, 2.5), + (1.0, 2.0, 4.0)); + +end; + +-- { dg-final { scan-assembler-not "elabs" } } diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer2.ads b/gcc/testsuite/gnat.dg/specs/static_initializer2.ads new file mode 100644 index 000000000..3b27f26bd --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer2.ads @@ -0,0 +1,22 @@ +-- { dg-do compile } + +package Static_Initializer2 is + + type A is array (1..5) of Integer; + f : constant A := (1, 2, 3, 4, 5); + + i1 : integer renames f(1); + i2 : integer renames f(2); + i3 : integer renames f(3); + i4 : integer renames f(4); + i5 : integer renames f(5); + + b1 : boolean := i1 = 1; + b2 : boolean := i2 = 2; + b3 : boolean := i3 = 3; + b4 : boolean := i4 = 4; + b5 : boolean := i5 = 5; + +end Static_Initializer2; + +-- { dg-final { scan-assembler-not "elabs" } } diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer3.ads b/gcc/testsuite/gnat.dg/specs/static_initializer3.ads new file mode 100644 index 000000000..2dc8be1e5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer3.ads @@ -0,0 +1,29 @@ +-- { dg-do compile } + +with Unchecked_Conversion; + +package Static_Initializer3 is + + type Byte is range 0 .. 16#FF#; + for Byte'Size use 8; + + type Word is range 0 .. 16#FFFF# ; + for Word'Size use 16; + + type R is record + b1 : Boolean; + b2 : Boolean; + end record; + for R use record + b1 at 0 range 0..3; + b2 at 0 range 4..7; + end record; + for R'Size use 8; + + function Conv is new Unchecked_Conversion (R, Byte); + + C1 : constant Byte := Conv ((true, false)); + + C2 : constant Word := Word(C1); + +end Static_Initializer3; diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer4.ads b/gcc/testsuite/gnat.dg/specs/static_initializer4.ads new file mode 100644 index 000000000..a1a5e846e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer4.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package Static_Initializer4 is + + type R is tagged record + b : Boolean; + end record; + + type NR is new R with null record; + + C : NR := (b => True); + +end Static_Initializer4; diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer5.ads b/gcc/testsuite/gnat.dg/specs/static_initializer5.ads new file mode 100644 index 000000000..29845ceeb --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer5.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +with Static_Initializer5_Pkg; use Static_Initializer5_Pkg; + +package Static_Initializer5 is + + type Derived is new Rec with record + Target : Boolean; + end record; + + Null_Derived : constant Derived := (Null_Rec with Target => False); + +end Static_Initializer5; diff --git a/gcc/testsuite/gnat.dg/specs/static_initializer5_pkg.ads b/gcc/testsuite/gnat.dg/specs/static_initializer5_pkg.ads new file mode 100644 index 000000000..16a8f7277 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/static_initializer5_pkg.ads @@ -0,0 +1,17 @@ +package Static_Initializer5_Pkg is + + type Arr is array (Positive range <>) of Character; + + type Buffer_Type (Length : Positive) is record + Content : Arr (1 .. Length); + end record; + + type Buffer_Access is access Buffer_Type; + + type Rec is tagged record + Buffer : Buffer_Access; + end record; + + Null_Rec : constant Rec := (Buffer => null); + +end Static_Initializer5_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/storage.ads b/gcc/testsuite/gnat.dg/specs/storage.ads new file mode 100644 index 000000000..e54445793 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/storage.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } +with System.Pool_Global; +package Storage is + x1: System.Pool_Global.Unbounded_No_Reclaim_Pool; + type T1 is access integer; + for T1'Storage_Pool use (x1); -- { dg-error "must be a variable" } + type T2 is access Integer; + for T2'Storage_Pool use x1; +end Storage; + diff --git a/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads b/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads new file mode 100644 index 000000000..4bccd255d --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads @@ -0,0 +1,14 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } + +package Sync_Iface_Test is + type Iface is limited interface; + procedure Do_Test + (Container : in out Iface; + Process : access procedure (E : Natural)) is abstract; + + protected type Buffer is new Iface with + overriding procedure Do_Test + (Process : access procedure (E : Natural)); + end; +end; diff --git a/gcc/testsuite/gnat.dg/specs/tag1.ads b/gcc/testsuite/gnat.dg/specs/tag1.ads new file mode 100644 index 000000000..7cf7c99dd --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/tag1.ads @@ -0,0 +1,8 @@ +-- { dg-do compile } + +package tag1 is + type T is tagged limited record + Y : access T'Class; -- OK + X : access Tag1.T'Class; -- Problem + end record; +end tag1; diff --git a/gcc/testsuite/gnat.dg/specs/tag2.ads b/gcc/testsuite/gnat.dg/specs/tag2.ads new file mode 100644 index 000000000..67b44978d --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/tag2.ads @@ -0,0 +1,17 @@ +-- { dg-do compile } + +package tag2 is + type I is synchronized interface; + type T1 is tagged; + type T2 is tagged; + type T3 is tagged; + type T4 is tagged; + type T5 is tagged; + 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 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; +end tag2; diff --git a/gcc/testsuite/gnat.dg/specs/uc1.ads b/gcc/testsuite/gnat.dg/specs/uc1.ads new file mode 100644 index 000000000..299782035 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/uc1.ads @@ -0,0 +1,22 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +with System; +with System.Storage_Elements; +with Unchecked_Conversion; + +package UC1 is + + function Conv is + new Unchecked_Conversion (Source => System.Address, Target => Integer); + function Conv is + new Unchecked_Conversion (Source => Integer, Target => System.Address); + + M : constant System.Address := System.Storage_Elements.To_Address(0); + N : constant System.Address := Conv (Conv (M) + 1); + A : constant System.Address := Conv (Conv (N) + 1); + + I : Integer; + for I use at A; + +end UC1; diff --git a/gcc/testsuite/gnat.dg/specs/unchecked_union.ads b/gcc/testsuite/gnat.dg/specs/unchecked_union.ads new file mode 100644 index 000000000..260f781d8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/unchecked_union.ads @@ -0,0 +1,20 @@ +-- PR ada/28591 +-- Reported by Martin Michlmayr + +-- { dg-do compile } +-- { dg-options "-g" } + +with Interfaces; use Interfaces; + +package Unchecked_Union is + type Mode_Type is (Mode_B2); + + type Value_Union (Mode : Mode_Type := Mode_B2) is record + case Mode is + when Mode_B2 => + B2 : Integer_32; + end case; + end record; + pragma Unchecked_Union (Value_Union); + +end Unchecked_Union; diff --git a/gcc/testsuite/gnat.dg/specs/universal_fixed.ads b/gcc/testsuite/gnat.dg/specs/universal_fixed.ads new file mode 100644 index 000000000..e54ce278c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/universal_fixed.ads @@ -0,0 +1,8 @@ +-- { dg-do compile } + +package Universal_Fixed is + Nm2Metres : constant := 1852.0; + type Metres is delta 1.0 range 0.0 .. 1_000_000.0; + type Nautical_Miles is + delta 0.001 range 0.0 .. (Metres'Last + (Nm2Metres / 2)) / Nm2Metres; +end Universal_Fixed; diff --git a/gcc/testsuite/gnat.dg/specs/variant_part.ads b/gcc/testsuite/gnat.dg/specs/variant_part.ads new file mode 100644 index 000000000..afc92cde5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/variant_part.ads @@ -0,0 +1,8 @@ +-- { dg-do compile } +package Variant_Part is + type T1(b: boolean) is record + case (b) is -- { dg-error "discriminant name may not be parenthesized" } + when others => null; + end case; + end record; +end Variant_Part; diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return.ads b/gcc/testsuite/gnat.dg/specs/varsize_return.ads new file mode 100644 index 000000000..b6c55ed63 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/varsize_return.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +with Varsize_Return_Pkg1; + +package Varsize_Return is + + package P is new Varsize_Return_Pkg1 (Id_T => Natural); + +end Varsize_Return; diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb new file mode 100644 index 000000000..59b283c2b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb @@ -0,0 +1,24 @@ +package body Varsize_Return_Pkg1 is + + function Is_Fixed return Boolean is + begin + return True; + end Is_Fixed; + + function Do_Item (I : Natural) return Variable_Data_Fixed_T is + It : Variable_Data_Fixed_T; + begin + return It; + end Do_Item; + + My_Db : Db.T; + + procedure Run is + Kitem : Variable_Data_Fixed_T; + I : Natural; + begin + Kitem := Db.Get (My_Db); + Kitem := Do_Item (I); + end Run; + +end Varsize_Return_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads new file mode 100644 index 000000000..792b7a5ce --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads @@ -0,0 +1,26 @@ +-- { dg-excess-errors "no code generated" } + +with Varsize_Return_Pkg2; + +generic + type Id_T is range <>; +package Varsize_Return_Pkg1 is + + type Variable_Data_T (Fixed : Boolean := False) is + record + case Fixed is + when True => + Length : Natural; + when False => + null; + end case; + end record; + + function Is_Fixed return Boolean; + + type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed); + + package Db is new Varsize_Return_Pkg2 (Id_T => Id_T, + Data_T => Variable_Data_Fixed_T); + +end Varsize_Return_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb new file mode 100644 index 000000000..d89255285 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb @@ -0,0 +1,7 @@ +package body Varsize_Return_Pkg2 is + function Get (X : T) return Data_T is + Result : Data_T; + begin + return Result; + end; +end Varsize_Return_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads new file mode 100644 index 000000000..9d1abb96c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads @@ -0,0 +1,11 @@ +-- { dg-excess-errors "no code generated" } + +generic + type Id_T is private; + type Data_T is private; +package Varsize_Return_Pkg2 is + type T is private; + function Get (X : T) return Data_T; +private + type T is null record; +end Varsize_Return_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/warnstar.ads b/gcc/testsuite/gnat.dg/specs/warnstar.ads new file mode 100644 index 000000000..325cbb6f3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/warnstar.ads @@ -0,0 +1,12 @@ +-- { dg-do compile } + +pragma Warnings (Off, "*bits of*unused"); +package warnstar is + type r is record + a : integer; + end record; + + for r use record + a at 0 range 0 .. 1023; + end record; +end warnstar; diff --git a/gcc/testsuite/gnat.dg/specs/weak1.ads b/gcc/testsuite/gnat.dg/specs/weak1.ads new file mode 100644 index 000000000..82cddc09a --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/weak1.ads @@ -0,0 +1,7 @@ +package Weak1 is + + Myconst : constant Integer := 1234; + pragma Export (C, Myconst, "myconst"); + pragma Weak_External (Myconst); + +end Weak1; diff --git a/gcc/testsuite/gnat.dg/specs/with_containers.ads b/gcc/testsuite/gnat.dg/specs/with_containers.ads new file mode 100644 index 000000000..f2329cf88 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/with_containers.ads @@ -0,0 +1,27 @@ +-- { dg-do compile } + +pragma Warnings (Off); +with Ada.Containers.Doubly_Linked_Lists; +with Ada.Containers.Hashed_Maps; +with Ada.Containers.Hashed_Sets; +with Ada.Containers.Indefinite_Doubly_Linked_Lists; +with Ada.Containers.Indefinite_Hashed_Maps; +with Ada.Containers.Indefinite_Hashed_Sets; +with Ada.Containers.Indefinite_Ordered_Maps; +with Ada.Containers.Indefinite_Ordered_Multisets; +with Ada.Containers.Indefinite_Ordered_Sets; +with Ada.Containers.Indefinite_Vectors; +with Ada.Containers.Ordered_Maps; +with Ada.Containers.Ordered_Multisets; +with Ada.Containers.Ordered_Sets; +with Ada.Containers.Prime_Numbers; +with Ada.Containers.Red_Black_Trees.Generic_Keys; +with Ada.Containers.Red_Black_Trees.Generic_Operations; +with Ada.Containers.Red_Black_Trees.Generic_Set_Operations; +with Ada.Containers.Red_Black_Trees; +with Ada.Containers.Restricted_Doubly_Linked_Lists; +with Ada.Containers.Vectors; + +package With_Containers is + pragma Remote_Types; +end With_Containers; -- cgit v1.2.3