From 7f4db7c80779ecbc57d1146654daf0acfe18de66 Mon Sep 17 00:00:00 2001 From: rus Date: Mon, 9 Nov 2009 20:58:24 +0000 Subject: merge from trunk git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/profile-stdlib@154052 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/gnat.dg/aggr11.adb | 17 ++++++++++ gcc/testsuite/gnat.dg/aggr11_pkg.ads | 14 ++++++++ gcc/testsuite/gnat.dg/discr21.adb | 34 +++++++++++++++++++ gcc/testsuite/gnat.dg/discr21.ads | 5 +++ gcc/testsuite/gnat.dg/discr21_pkg.ads | 19 +++++++++++ gcc/testsuite/gnat.dg/discr22.adb | 23 +++++++++++++ gcc/testsuite/gnat.dg/loop_optimization7.adb | 16 +++++++++ gcc/testsuite/gnat.dg/loop_optimization7.ads | 9 +++++ gcc/testsuite/gnat.dg/loop_optimization7_pkg.ads | 10 ++++++ gcc/testsuite/gnat.dg/nested_proc.adb | 33 ------------------ gcc/testsuite/gnat.dg/nested_proc1.adb | 33 ++++++++++++++++++ gcc/testsuite/gnat.dg/nested_proc2.adb | 30 +++++++++++++++++ gcc/testsuite/gnat.dg/noreturn1.adb | 15 +++++++++ gcc/testsuite/gnat.dg/noreturn1.ads | 8 +++++ gcc/testsuite/gnat.dg/noreturn2.adb | 23 +++++++++++++ gcc/testsuite/gnat.dg/noreturn2.ads | 8 +++++ gcc/testsuite/gnat.dg/null_pointer_deref1.adb | 21 ++++++++++++ gcc/testsuite/gnat.dg/null_pointer_deref2.adb | 28 +++++++++++++++ gcc/testsuite/gnat.dg/opt3.adb | 11 ++++++ gcc/testsuite/gnat.dg/opt3_pkg.ads | 5 +++ gcc/testsuite/gnat.dg/opt4.adb | 22 ++++++++++++ gcc/testsuite/gnat.dg/opt5.adb | 21 ++++++++++++ gcc/testsuite/gnat.dg/pack14.adb | 16 +++++++++ gcc/testsuite/gnat.dg/slice8.adb | 13 +++++++ gcc/testsuite/gnat.dg/slice8_pkg1.ads | 3 ++ gcc/testsuite/gnat.dg/slice8_pkg2.ads | 23 +++++++++++++ gcc/testsuite/gnat.dg/slice8_pkg3.adb | 17 ++++++++++ gcc/testsuite/gnat.dg/slice8_pkg3.ads | 11 ++++++ gcc/testsuite/gnat.dg/specs/import_abstract.ads | 6 ++++ gcc/testsuite/gnat.dg/specs/pack4.ads | 12 +++++++ gcc/testsuite/gnat.dg/specs/pack5.ads | 13 +++++++ gcc/testsuite/gnat.dg/specs/rep_clause4.ads | 42 +++++++++++++++++++++++ gcc/testsuite/gnat.dg/stack_check1.adb | 38 +++++++++++++++++++++ gcc/testsuite/gnat.dg/stack_check2.adb | 43 ++++++++++++++++++++++++ gcc/testsuite/gnat.dg/timer_cancel.adb | 38 +++++++++++++++++++++ gcc/testsuite/gnat.dg/unchecked_convert4.adb | 24 +++++++++++++ 36 files changed, 671 insertions(+), 33 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/aggr11.adb create mode 100644 gcc/testsuite/gnat.dg/aggr11_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/discr21.adb create mode 100644 gcc/testsuite/gnat.dg/discr21.ads create mode 100644 gcc/testsuite/gnat.dg/discr21_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/discr22.adb create mode 100644 gcc/testsuite/gnat.dg/loop_optimization7.adb create mode 100644 gcc/testsuite/gnat.dg/loop_optimization7.ads create mode 100644 gcc/testsuite/gnat.dg/loop_optimization7_pkg.ads delete mode 100644 gcc/testsuite/gnat.dg/nested_proc.adb create mode 100644 gcc/testsuite/gnat.dg/nested_proc1.adb create mode 100644 gcc/testsuite/gnat.dg/nested_proc2.adb create mode 100644 gcc/testsuite/gnat.dg/noreturn1.adb create mode 100644 gcc/testsuite/gnat.dg/noreturn1.ads create mode 100644 gcc/testsuite/gnat.dg/noreturn2.adb create mode 100644 gcc/testsuite/gnat.dg/noreturn2.ads create mode 100644 gcc/testsuite/gnat.dg/null_pointer_deref1.adb create mode 100644 gcc/testsuite/gnat.dg/null_pointer_deref2.adb create mode 100644 gcc/testsuite/gnat.dg/opt3.adb create mode 100644 gcc/testsuite/gnat.dg/opt3_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/opt4.adb create mode 100644 gcc/testsuite/gnat.dg/opt5.adb create mode 100644 gcc/testsuite/gnat.dg/pack14.adb create mode 100644 gcc/testsuite/gnat.dg/slice8.adb create mode 100644 gcc/testsuite/gnat.dg/slice8_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/slice8_pkg2.ads create mode 100644 gcc/testsuite/gnat.dg/slice8_pkg3.adb create mode 100644 gcc/testsuite/gnat.dg/slice8_pkg3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/import_abstract.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/rep_clause4.ads create mode 100644 gcc/testsuite/gnat.dg/stack_check1.adb create mode 100644 gcc/testsuite/gnat.dg/stack_check2.adb create mode 100644 gcc/testsuite/gnat.dg/timer_cancel.adb create mode 100644 gcc/testsuite/gnat.dg/unchecked_convert4.adb (limited to 'gcc/testsuite/gnat.dg') diff --git a/gcc/testsuite/gnat.dg/aggr11.adb b/gcc/testsuite/gnat.dg/aggr11.adb new file mode 100644 index 00000000000..1771d62cacb --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr11.adb @@ -0,0 +1,17 @@ +-- { dg-do compile } +-- { dg-options "-O" } + +with Aggr11_Pkg; use Aggr11_Pkg; + +procedure Aggr11 is + + A : Arr := ((1 => (Kind => No_Error, B => True), + 2 => (Kind => Error), + 3 => (Kind => Error), + 4 => (Kind => No_Error, B => True), + 5 => (Kind => No_Error, B => True), + 6 => (Kind => No_Error, B => True))); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/aggr11_pkg.ads b/gcc/testsuite/gnat.dg/aggr11_pkg.ads new file mode 100644 index 00000000000..37008605a30 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr11_pkg.ads @@ -0,0 +1,14 @@ +package Aggr11_Pkg is + + type Error_Type is (No_Error, Error); + + type Rec (Kind : Error_Type := No_Error) is record + case Kind is + when Error => null; + when others => B : Boolean; + end case; + end record; + + type Arr is array (1..6) of Rec; + +end Aggr11_Pkg; diff --git a/gcc/testsuite/gnat.dg/discr21.adb b/gcc/testsuite/gnat.dg/discr21.adb new file mode 100644 index 00000000000..5c105cdb25c --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr21.adb @@ -0,0 +1,34 @@ +-- { dg-do compile } +-- { dg-options "-gnatws -O3" } + +with Discr21_Pkg; use Discr21_Pkg; + +package body Discr21 is + + type Index is new Natural range 0 .. 100; + + type Arr is array (Index range <> ) of Position; + + type Rec(Size : Index := 1) is record + A : Arr(1 .. Size); + end record; + + Data : Rec; + + function To_V(pos : Position) return VPosition is + begin + return To_Position(pos.x, pos.y, pos.z); + end; + + procedure Read(Data : Rec) is + pos : VPosition := To_V (Data.A(1)); + begin + null; + end; + + procedure Test is + begin + Read (Data); + end; + +end Discr21; diff --git a/gcc/testsuite/gnat.dg/discr21.ads b/gcc/testsuite/gnat.dg/discr21.ads new file mode 100644 index 00000000000..8de8ed08b76 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr21.ads @@ -0,0 +1,5 @@ +package Discr21 is + + procedure Test; + +end Discr21; diff --git a/gcc/testsuite/gnat.dg/discr21_pkg.ads b/gcc/testsuite/gnat.dg/discr21_pkg.ads new file mode 100644 index 00000000000..d156df62517 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr21_pkg.ads @@ -0,0 +1,19 @@ +package Discr21_Pkg is + + type Position is record + x,y,z : Float; + end record; + + type Dim is (Two, Three); + + type VPosition (D: Dim := Three) is record + x, y : Float; + case D is + when Two => null; + when Three => z : Float; + end case; + end record; + + function To_Position (x, y, z : Float) return VPosition; + +end Discr21_Pkg; diff --git a/gcc/testsuite/gnat.dg/discr22.adb b/gcc/testsuite/gnat.dg/discr22.adb new file mode 100644 index 00000000000..af4f9ab7899 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr22.adb @@ -0,0 +1,23 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +procedure Discr22 is + + subtype Precision is Integer range 1 .. 5; + + type Rec(D1 : Precision; D2 : Integer) is record + case D1 is + when 1 => I : Integer; + when others => null; + end case; + end record; + for Rec use record + D1 at 0 range 0 .. 7; + end record; + + P : Precision; + X : Rec(P, 0); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/loop_optimization7.adb b/gcc/testsuite/gnat.dg/loop_optimization7.adb new file mode 100644 index 00000000000..16683949465 --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization7.adb @@ -0,0 +1,16 @@ +-- { dg-do compile } +-- { dg-options "-O3" } +-- { dg-options "-O3 -msse" { target i?86-*-* x86_64-*-* } } + +package body Loop_Optimization7 is + + function Conv (A : Arr) return Arr is + Result : Arr; + begin + for I in A'Range loop + Result (I) := Conv (A (I)); + end loop; + return Result; + end; + +end Loop_Optimization7; diff --git a/gcc/testsuite/gnat.dg/loop_optimization7.ads b/gcc/testsuite/gnat.dg/loop_optimization7.ads new file mode 100644 index 00000000000..ab0a165ea90 --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization7.ads @@ -0,0 +1,9 @@ +with Loop_Optimization7_Pkg; use Loop_Optimization7_Pkg; + +package Loop_Optimization7 is + + type Arr is array (1..8) of Rec; + + function Conv (A : Arr) return Arr; + +end Loop_Optimization7; diff --git a/gcc/testsuite/gnat.dg/loop_optimization7_pkg.ads b/gcc/testsuite/gnat.dg/loop_optimization7_pkg.ads new file mode 100644 index 00000000000..0eaefa1b0f3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization7_pkg.ads @@ -0,0 +1,10 @@ +package Loop_Optimization7_Pkg is + pragma Pure; + + type Rec is record + F : Float; + end record; + + function Conv (Trig : Rec) return Rec; + +end Loop_Optimization7_Pkg; diff --git a/gcc/testsuite/gnat.dg/nested_proc.adb b/gcc/testsuite/gnat.dg/nested_proc.adb deleted file mode 100644 index 144533c2832..00000000000 --- a/gcc/testsuite/gnat.dg/nested_proc.adb +++ /dev/null @@ -1,33 +0,0 @@ --- { dg-do run } --- Test that a static link is correctly passed to a subprogram which is --- indirectly called through an aggregate. - -procedure Nested_Proc is - - I : Integer := 0; - - procedure P1 (X : Integer) is - begin - I := X; - end; - - type Func_Ptr is access procedure (X : Integer); - - type Arr is array (1..64) of Integer; - - type Rec is record - F : Func_Ptr; - A : Arr; - end record; - - procedure P2 (R : Rec) is - begin - R.F (1); - end; - -begin - P2 ((F => P1'Access, A => (others => 0))); - if I /= 1 then - raise Program_Error; - end if; -end; diff --git a/gcc/testsuite/gnat.dg/nested_proc1.adb b/gcc/testsuite/gnat.dg/nested_proc1.adb new file mode 100644 index 00000000000..b3abf262578 --- /dev/null +++ b/gcc/testsuite/gnat.dg/nested_proc1.adb @@ -0,0 +1,33 @@ +-- { dg-do run } +-- Test that a static link is correctly passed to a subprogram which is +-- indirectly called through an aggregate. + +procedure Nested_Proc1 is + + I : Integer := 0; + + procedure P1 (X : Integer) is + begin + I := X; + end; + + type Func_Ptr is access procedure (X : Integer); + + type Arr is array (1..64) of Integer; + + type Rec is record + F : Func_Ptr; + A : Arr; + end record; + + procedure P2 (R : Rec) is + begin + R.F (1); + end; + +begin + P2 ((F => P1'Access, A => (others => 0))); + if I /= 1 then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/nested_proc2.adb b/gcc/testsuite/gnat.dg/nested_proc2.adb new file mode 100644 index 00000000000..b5349563a99 --- /dev/null +++ b/gcc/testsuite/gnat.dg/nested_proc2.adb @@ -0,0 +1,30 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +procedure Nested_Proc2 is + + type Arr is array(1..2) of Integer; + + type Rec is record + Data : Arr; + end record; + + From : Rec; + Index : Integer; + + function F (X : Arr) return Integer is + begin + return 0; + end; + + procedure Test is + begin + Index := F (From.Data); + If Index /= 0 then + raise Program_Error; + end if; + end; + +begin + Test; +end; diff --git a/gcc/testsuite/gnat.dg/noreturn1.adb b/gcc/testsuite/gnat.dg/noreturn1.adb new file mode 100644 index 00000000000..83eafe7f364 --- /dev/null +++ b/gcc/testsuite/gnat.dg/noreturn1.adb @@ -0,0 +1,15 @@ +-- { dg-compile } + +package body Noreturn1 is + + procedure Error (E : in Exception_Occurrence) is + Occurrence_Message : constant String := Exception_Message (E); + begin + if Occurrence_Message = "$" then + raise Program_Error; + else + raise Constraint_Error; + end if; + end; + +end Noreturn1; diff --git a/gcc/testsuite/gnat.dg/noreturn1.ads b/gcc/testsuite/gnat.dg/noreturn1.ads new file mode 100644 index 00000000000..c63e4399907 --- /dev/null +++ b/gcc/testsuite/gnat.dg/noreturn1.ads @@ -0,0 +1,8 @@ +with Ada.Exceptions; use Ada.Exceptions; + +package Noreturn1 is + + procedure Error (E : in Exception_Occurrence); + pragma No_Return (Error); + +end Noreturn1; diff --git a/gcc/testsuite/gnat.dg/noreturn2.adb b/gcc/testsuite/gnat.dg/noreturn2.adb new file mode 100644 index 00000000000..5caf222f29b --- /dev/null +++ b/gcc/testsuite/gnat.dg/noreturn2.adb @@ -0,0 +1,23 @@ +-- { dg-do compile } + +package body Noreturn2 is + + procedure Raise_Exception_No_Defer (Message : String); + pragma No_Return (Raise_Exception_No_Defer); + + procedure Raise_From (X : Exception_Occurrence) is + Occurrence_Message : constant String := Exception_Message (X); + begin + if Occurrence_Message = "$" then + Raise_Exception_No_Defer (Occurrence_Message); + else + Raise_Exception_No_Defer ("::" & Occurrence_Message); + end if; + end; + + procedure Raise_Exception_No_Defer (Message : String) is + begin + raise Program_Error; + end; + +end Noreturn2; diff --git a/gcc/testsuite/gnat.dg/noreturn2.ads b/gcc/testsuite/gnat.dg/noreturn2.ads new file mode 100644 index 00000000000..1aaf4e97446 --- /dev/null +++ b/gcc/testsuite/gnat.dg/noreturn2.ads @@ -0,0 +1,8 @@ +with Ada.Exceptions; use Ada.Exceptions; + +package Noreturn2 is + + procedure Raise_From (X : Exception_Occurrence); + pragma No_Return (Raise_From); + +end Noreturn2; diff --git a/gcc/testsuite/gnat.dg/null_pointer_deref1.adb b/gcc/testsuite/gnat.dg/null_pointer_deref1.adb new file mode 100644 index 00000000000..6e7bf14e5df --- /dev/null +++ b/gcc/testsuite/gnat.dg/null_pointer_deref1.adb @@ -0,0 +1,21 @@ +-- { dg-do run } +-- { dg-options "-gnatp" } + +-- This test requires architecture- and OS-specific support code for unwinding +-- through signal frames (typically located in *-unwind.h) to pass. Feel free +-- to disable it if this code hasn't been implemented yet. + +procedure Null_Pointer_Deref1 is + type Int_Ptr is access all Integer; + + function Ident return Int_Ptr is + begin + return null; + end; + + Data : Int_Ptr := Ident; +begin + Data.all := 1; +exception + when Constraint_Error | Storage_Error => null; +end; diff --git a/gcc/testsuite/gnat.dg/null_pointer_deref2.adb b/gcc/testsuite/gnat.dg/null_pointer_deref2.adb new file mode 100644 index 00000000000..63e2dd11f39 --- /dev/null +++ b/gcc/testsuite/gnat.dg/null_pointer_deref2.adb @@ -0,0 +1,28 @@ +-- { dg-do run } +-- { dg-options "-gnatp" } + +-- This test requires architecture- and OS-specific support code for unwinding +-- through signal frames (typically located in *-unwind.h) to pass. Feel free +-- to disable it if this code hasn't been implemented yet. + +procedure Null_Pointer_Deref2 is + + task T; + + task body T is + type Int_Ptr is access all Integer; + + function Ident return Int_Ptr is + begin + return null; + end; + Data : Int_Ptr := Ident; + begin + Data.all := 1; + exception + when Constraint_Error | Storage_Error => null; + end T; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/opt3.adb b/gcc/testsuite/gnat.dg/opt3.adb new file mode 100644 index 00000000000..b8ca2c7fba6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt3.adb @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-O3" } + +with Opt3_Pkg; use Opt3_Pkg; + +procedure Opt3 is + type Buffer_Type is array (Integer range <> ) of Short_Integer; + B : Buffer_Type (1 .. 256) := (others => 0); +begin + F (B(1)); +end; diff --git a/gcc/testsuite/gnat.dg/opt3_pkg.ads b/gcc/testsuite/gnat.dg/opt3_pkg.ads new file mode 100644 index 00000000000..458a98be2de --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt3_pkg.ads @@ -0,0 +1,5 @@ +package Opt3_Pkg is + + procedure F (I : Short_Integer); + +end Opt3_Pkg; diff --git a/gcc/testsuite/gnat.dg/opt4.adb b/gcc/testsuite/gnat.dg/opt4.adb new file mode 100644 index 00000000000..caa5ab3a6cb --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt4.adb @@ -0,0 +1,22 @@ +-- { dg-do run } +-- { dg-options "-O2" } + +procedure Opt4 is + + type Rec (D : Natural) is record + S : String (1..D); + end record; + + procedure Test (R : Rec) is + begin + if R.D /= 9 then + raise Program_Error; + end if; + end; + + R : Rec(9); + +begin + R := (9, "123456789"); + Test (R); +end; diff --git a/gcc/testsuite/gnat.dg/opt5.adb b/gcc/testsuite/gnat.dg/opt5.adb new file mode 100644 index 00000000000..73a21bde023 --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt5.adb @@ -0,0 +1,21 @@ +-- { dg-do run } +-- { dg-options "-O2" } + +procedure Opt5 is + + type Varray is array (1 .. 4) of Natural; + + procedure Check_All_Ones (A : Varray) is + begin + for J in A'Range loop + if (A (J)) /= 1 then + raise Program_Error; + end if; + end loop; + end; + + X : constant Varray := (1, 1, 1, 1); + +begin + Check_All_Ones (X); +end; diff --git a/gcc/testsuite/gnat.dg/pack14.adb b/gcc/testsuite/gnat.dg/pack14.adb new file mode 100644 index 00000000000..b3764316b2c --- /dev/null +++ b/gcc/testsuite/gnat.dg/pack14.adb @@ -0,0 +1,16 @@ +-- { dg-do compile } + +procedure Pack14 is + + subtype False_T is Boolean range False .. False; + + type Rec is record + F : False_T; + end record; + pragma Pack (Rec); + + A : Rec := (F => False); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/slice8.adb b/gcc/testsuite/gnat.dg/slice8.adb new file mode 100644 index 00000000000..b05829d0f7b --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice8.adb @@ -0,0 +1,13 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +with Slice8_Pkg1; +with Slice8_Pkg3; + +procedure Slice8 is + + package Bp is new Slice8_Pkg3 (Slice8_Pkg1); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/slice8_pkg1.ads b/gcc/testsuite/gnat.dg/slice8_pkg1.ads new file mode 100644 index 00000000000..3f433fdfb26 --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice8_pkg1.ads @@ -0,0 +1,3 @@ +with Slice8_Pkg2; + +package Slice8_Pkg1 is new Slice8_Pkg2 (Line_Length => 132, Max_Lines => 1000); diff --git a/gcc/testsuite/gnat.dg/slice8_pkg2.ads b/gcc/testsuite/gnat.dg/slice8_pkg2.ads new file mode 100644 index 00000000000..a6eafc6aa18 --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice8_pkg2.ads @@ -0,0 +1,23 @@ +generic + + Line_Length : Natural; + Max_Lines : Natural; + +package Slice8_Pkg2 is + + Subtype Index is Natural Range 0..Line_length; + Subtype Line_Count is Natural Range 0..Max_Lines; + + Type Line (Size : Index := 0) is + Record + Data : String (1..Size); + End Record; + + Type Lines is Array (Line_Count Range <>) of Line; + + Type Paragraph (Size : Line_Count) is + Record + Data : Lines (1..Size); + End Record; + +end Slice8_Pkg2; diff --git a/gcc/testsuite/gnat.dg/slice8_pkg3.adb b/gcc/testsuite/gnat.dg/slice8_pkg3.adb new file mode 100644 index 00000000000..3524de1f0f5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice8_pkg3.adb @@ -0,0 +1,17 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +package body Slice8_Pkg3 is + + Current : Str.Lines (Str.Line_Count); + Last : Natural := 0; + + function Get return Str.Paragraph is + Result : constant Str.Paragraph := (Size => Last, + Data => Current (1..Last)); + begin + Last := 0; + return Result; + end Get; + +end Slice8_Pkg3; diff --git a/gcc/testsuite/gnat.dg/slice8_pkg3.ads b/gcc/testsuite/gnat.dg/slice8_pkg3.ads new file mode 100644 index 00000000000..a802cb72d9b --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice8_pkg3.ads @@ -0,0 +1,11 @@ +with Slice8_Pkg2; + +generic + + with package Str is new Slice8_Pkg2 (<>); + +package Slice8_Pkg3 is + + function Get return Str.Paragraph; + +end Slice8_Pkg3; 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 00000000000..9d05f0c1ceb --- /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/pack4.ads b/gcc/testsuite/gnat.dg/specs/pack4.ads new file mode 100644 index 00000000000..82b76d2f457 --- /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 00000000000..65c8fc744de --- /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/rep_clause4.ads b/gcc/testsuite/gnat.dg/specs/rep_clause4.ads new file mode 100644 index 00000000000..8009f876cf2 --- /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/stack_check1.adb b/gcc/testsuite/gnat.dg/stack_check1.adb new file mode 100644 index 00000000000..51ee1a633b3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/stack_check1.adb @@ -0,0 +1,38 @@ +-- { dg-do run } +-- { dg-options "-fstack-check" } + +-- This test requires architecture- and OS-specific support code for unwinding +-- through signal frames (typically located in *-unwind.h) to pass. Feel free +-- to disable it if this code hasn't been implemented yet. + +procedure Stack_Check1 is + + type A is Array (1..2048) of Integer; + + procedure Consume_Stack (N : Integer) is + My_A : A; -- 8 KB static + begin + My_A (1) := 0; + if N <= 0 then + return; + end if; + Consume_Stack (N-1); + end; + + Task T; + + Task body T is + begin + begin + Consume_Stack (Integer'Last); + raise Program_Error; + exception + when Storage_Error => null; + end; + + Consume_Stack (128); + end; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/stack_check2.adb b/gcc/testsuite/gnat.dg/stack_check2.adb new file mode 100644 index 00000000000..4a3008ba02b --- /dev/null +++ b/gcc/testsuite/gnat.dg/stack_check2.adb @@ -0,0 +1,43 @@ +-- { dg-do run } +-- { dg-options "-fstack-check" } + +-- This test requires architecture- and OS-specific support code for unwinding +-- through signal frames (typically located in *-unwind.h) to pass. Feel free +-- to disable it if this code hasn't been implemented yet. + +procedure Stack_Check2 is + + function UB return Integer is + begin + return 2048; + end; + + type A is Array (Positive range <>) of Integer; + + procedure Consume_Stack (N : Integer) is + My_A : A (1..UB); -- 8 KB dynamic + begin + My_A (1) := 0; + if N <= 0 then + return; + end if; + Consume_Stack (N-1); + end; + + Task T; + + Task body T is + begin + begin + Consume_Stack (Integer'Last); + raise Program_Error; + exception + when Storage_Error => null; + end; + + Consume_Stack (128); + end; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/timer_cancel.adb b/gcc/testsuite/gnat.dg/timer_cancel.adb new file mode 100644 index 00000000000..c300b47a859 --- /dev/null +++ b/gcc/testsuite/gnat.dg/timer_cancel.adb @@ -0,0 +1,38 @@ +-- { dg-do run } + +with Ada.Real_Time.Timing_Events; +use Ada.Real_Time, Ada.Real_Time.Timing_Events; + +procedure Timer_Cancel is + + E : Timing_Event; + C : Boolean; + + protected Dummy is + procedure Trigger (Event : in out Timing_Event); + end Dummy; + + protected body Dummy is + procedure Trigger (Event : in out Timing_Event) is + begin + null; + end Trigger; + end Dummy; + +begin + Set_Handler (E, Time_Last, Dummy.Trigger'Unrestricted_Access); + + if Time_Of_Event (E) /= Time_Last then + raise Program_Error with "Event time not set correctly"; + end if; + + Cancel_Handler (E, C); + + if not C then + raise Program_Error with "Event triggered already"; + end if; + + if Time_Of_Event (E) /= Time_First then + raise Program_Error with "Event time not reset correctly"; + end if; +end Timer_Cancel; diff --git a/gcc/testsuite/gnat.dg/unchecked_convert4.adb b/gcc/testsuite/gnat.dg/unchecked_convert4.adb new file mode 100644 index 00000000000..8f3a1aa4efe --- /dev/null +++ b/gcc/testsuite/gnat.dg/unchecked_convert4.adb @@ -0,0 +1,24 @@ +-- { dg-do compile } + +with Unchecked_Conversion; + +procedure Unchecked_Convert4 is + + type Uint32 is mod 2**32; + + type Rec is record + I : Uint32; + end record; + for Rec'Size use 32; + pragma Atomic (Rec); + + function Conv is new Unchecked_Conversion (Uint32, Rec); + + function F return Uint32; + pragma Import (Ada, F); + + procedure Proc (R : Rec) is begin null; end; + +begin + Proc (Conv (F or 1)); +end; -- cgit v1.2.1