diff options
Diffstat (limited to 'gcc')
17 files changed, 87 insertions, 35 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9a156a6..f3b1f9b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,31 @@ +2018-02-16 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/84277 + * gnat.dg/array11.adb (Array11): Tweak index and remove warning. + * gnat.dg/dispatch1.adb: Rename into... + * gnat.dg/disp1.adb: ...this. + * gnat.dg/dispatch1_p.ads: Rename into... + * gnat.dg/disp1_pkg.ads: ...this. + * gnat.dg/disp2.adb: Rename into... + * gnat.dg/dispatch2.adb: ...this. + * gnat.dg/dispatch2_p.ads: Rename into... + * gnat.dg/disp2_pkg.ads: ...this. + * gnat.dg/dispatch2_p.adb: Rename into... + * gnat.dg/disp2_pkg.adb: this. + * gnat.dg/generic_dispatch.adb: Rename into... + * gnat.dg/generic_disp.adb: this. + * gnat.dg/generic_dispatch_p.ads: Rename into... + * gnat.dg/generic_disp_pkg.ads: ...this. + * gnat.dg/generic_dispatch_p.adb: Rename into... + * gnat.dg/generic_disp_pkg.adb: ...this. + * gnat.dg/null_pointer_deref1.adb (Null_Pointer_Deref1): Robustify. + * gnat.dg/null_pointer_deref2.adb (Null_Pointer_Deref2): Likewise. + * gnat.dg/object_overflow1.adb: Tweak index. + * gnat.dg/object_overflow2.adb: Likewise. + * gnat.dg/object_overflow3.adb: Likewise. + * gnat.dg/object_overflow4.adb: Likewise. + * gnat.dg/object_overflow5.adb: Likewise. + 2018-02-16 Jakub Jelinek <jakub@redhat.com> PR ipa/84425 diff --git a/gcc/testsuite/gnat.dg/array11.adb b/gcc/testsuite/gnat.dg/array11.adb index 7be61c4..aab7347 100644 --- a/gcc/testsuite/gnat.dg/array11.adb +++ b/gcc/testsuite/gnat.dg/array11.adb @@ -1,15 +1,17 @@ -- { dg-do compile } +with System; + procedure Array11 is type Rec is null record; - type Ptr is access all Rec; + type Index_T is mod System.Memory_Size; - type Arr1 is array (1..8) of aliased Rec; -- { dg-warning "padded" } - type Arr2 is array (Long_Integer) of aliased Rec; -- { dg-warning "padded" } + type Arr1 is array (1 .. 8) of aliased Rec; -- { dg-warning "padded" } + type Arr2 is array (Index_T) of aliased Rec; -- { dg-warning "padded" } A1 : Arr1; - A2 : Arr2; -- { dg-warning "Storage_Error" } + A2 : Arr2; begin null; diff --git a/gcc/testsuite/gnat.dg/dispatch1.adb b/gcc/testsuite/gnat.dg/disp1.adb index 28e97e6..2fcefea 100644 --- a/gcc/testsuite/gnat.dg/dispatch1.adb +++ b/gcc/testsuite/gnat.dg/disp1.adb @@ -1,7 +1,8 @@ -- { dg-do run } -with dispatch1_p; use dispatch1_p; -procedure dispatch1 is +with Disp1_Pkg; use Disp1_Pkg; + +procedure Disp1 is O : DT_I1; Ptr : access I1'Class; begin diff --git a/gcc/testsuite/gnat.dg/dispatch1_p.ads b/gcc/testsuite/gnat.dg/disp1_pkg.ads index 73de627..4d80e76 100644 --- a/gcc/testsuite/gnat.dg/dispatch1_p.ads +++ b/gcc/testsuite/gnat.dg/disp1_pkg.ads @@ -1,4 +1,6 @@ -package dispatch1_p is +package Disp1_Pkg is + type I1 is interface; type DT_I1 is new I1 with null record; -end; + +end Disp1_Pkg; diff --git a/gcc/testsuite/gnat.dg/dispatch2.adb b/gcc/testsuite/gnat.dg/disp2.adb index ed57b13..2e1e622 100644 --- a/gcc/testsuite/gnat.dg/dispatch2.adb +++ b/gcc/testsuite/gnat.dg/disp2.adb @@ -1,7 +1,8 @@ -- { dg-do run } -with dispatch2_p; use dispatch2_p; -procedure dispatch2 is +with Disp2_Pkg; use Disp2_Pkg; + +procedure Disp2 is Obj : Object_Ptr := new Object; begin if Obj.Get_Ptr /= Obj.Impl_Of then diff --git a/gcc/testsuite/gnat.dg/dispatch2_p.adb b/gcc/testsuite/gnat.dg/disp2_pkg.adb index 243c3ca..ed460ec 100644 --- a/gcc/testsuite/gnat.dg/dispatch2_p.adb +++ b/gcc/testsuite/gnat.dg/disp2_pkg.adb @@ -1,7 +1,8 @@ --- -package body dispatch2_p is +package body Disp2_Pkg is + function Impl_Of (Self : access Object) return Object_Ptr is begin return Object_Ptr (Self); end Impl_Of; -end; + +end Disp2_Pkg; diff --git a/gcc/testsuite/gnat.dg/dispatch2_p.ads b/gcc/testsuite/gnat.dg/disp2_pkg.ads index e7852b4..0b4903a 100644 --- a/gcc/testsuite/gnat.dg/dispatch2_p.ads +++ b/gcc/testsuite/gnat.dg/disp2_pkg.ads @@ -1,8 +1,11 @@ -package dispatch2_p is +package Disp2_Pkg is + type Object is tagged null record; type Object_Ptr is access all Object'CLASS; --- + function Impl_Of (Self : access Object) return Object_Ptr; function Get_Ptr (Self : access Object) return Object_Ptr renames Impl_Of; -end; + +end Disp2_Pkg; + diff --git a/gcc/testsuite/gnat.dg/generic_dispatch.adb b/gcc/testsuite/gnat.dg/generic_disp.adb index a22e495..2f828ff 100644 --- a/gcc/testsuite/gnat.dg/generic_dispatch.adb +++ b/gcc/testsuite/gnat.dg/generic_disp.adb @@ -1,9 +1,10 @@ -- { dg-do run } -with generic_dispatch_p; use generic_dispatch_p; -procedure generic_dispatch is +with Generic_Disp_Pkg; use Generic_Disp_Pkg; + +procedure Generic_Disp is I : aliased Integer := 0; D : Iface'Class := Dispatching_Constructor (DT'Tag, I'access); begin null; -end generic_dispatch; +end Generic_Disp; diff --git a/gcc/testsuite/gnat.dg/generic_dispatch_p.adb b/gcc/testsuite/gnat.dg/generic_disp_pkg.adb index 7a4bbbd..b3aeb3f 100644 --- a/gcc/testsuite/gnat.dg/generic_dispatch_p.adb +++ b/gcc/testsuite/gnat.dg/generic_disp_pkg.adb @@ -1,7 +1,9 @@ -package body generic_dispatch_p is +package body Generic_Disp_Pkg is + function Constructor (I : not null access Integer) return DT is R : DT; - begin + begin return R; end Constructor; -end; + +end Generic_Disp_Pkg; diff --git a/gcc/testsuite/gnat.dg/generic_dispatch_p.ads b/gcc/testsuite/gnat.dg/generic_disp_pkg.ads index fe6115d..5be5492 100644 --- a/gcc/testsuite/gnat.dg/generic_dispatch_p.ads +++ b/gcc/testsuite/gnat.dg/generic_disp_pkg.ads @@ -1,5 +1,6 @@ with Ada.Tags.Generic_Dispatching_Constructor; -package generic_dispatch_p is + +package Generic_Disp_Pkg is type Iface is interface; function Constructor (I : not null access Integer) return Iface is abstract; function Dispatching_Constructor @@ -10,4 +11,4 @@ package generic_dispatch_p is type DT is new Iface with null record; overriding function Constructor (I : not null access Integer) return DT; -end; +end Generic_Disp_Pkg; diff --git a/gcc/testsuite/gnat.dg/null_pointer_deref1.adb b/gcc/testsuite/gnat.dg/null_pointer_deref1.adb index 6e7bf14..ec7f946 100644 --- a/gcc/testsuite/gnat.dg/null_pointer_deref1.adb +++ b/gcc/testsuite/gnat.dg/null_pointer_deref1.adb @@ -17,5 +17,5 @@ procedure Null_Pointer_Deref1 is begin Data.all := 1; exception - when Constraint_Error | Storage_Error => null; + when others => null; end; diff --git a/gcc/testsuite/gnat.dg/null_pointer_deref2.adb b/gcc/testsuite/gnat.dg/null_pointer_deref2.adb index 63e2dd1..2847622 100644 --- a/gcc/testsuite/gnat.dg/null_pointer_deref2.adb +++ b/gcc/testsuite/gnat.dg/null_pointer_deref2.adb @@ -20,7 +20,7 @@ procedure Null_Pointer_Deref2 is begin Data.all := 1; exception - when Constraint_Error | Storage_Error => null; + when others => null; end T; begin diff --git a/gcc/testsuite/gnat.dg/object_overflow1.adb b/gcc/testsuite/gnat.dg/object_overflow1.adb index ba7f657..d972f24 100644 --- a/gcc/testsuite/gnat.dg/object_overflow1.adb +++ b/gcc/testsuite/gnat.dg/object_overflow1.adb @@ -1,10 +1,12 @@ -- { dg-do compile } +with Interfaces.C; use Interfaces.C; + procedure Object_Overflow1 is procedure Proc (x : Boolean) is begin null; end; - type Arr is array(Long_Integer) of Boolean; + type Arr is array(ptrdiff_t) of Boolean; Obj : Arr; -- { dg-warning "Storage_Error" } begin diff --git a/gcc/testsuite/gnat.dg/object_overflow2.adb b/gcc/testsuite/gnat.dg/object_overflow2.adb index 9601c56..a429291 100644 --- a/gcc/testsuite/gnat.dg/object_overflow2.adb +++ b/gcc/testsuite/gnat.dg/object_overflow2.adb @@ -1,10 +1,12 @@ -- { dg-do compile } +with Interfaces.C; use Interfaces.C; + procedure Object_Overflow2 is procedure Proc (x : Boolean) is begin null; end; - type Arr is array(0 .. Long_Integer'Last) of Boolean; + type Arr is array(0 .. ptrdiff_t'Last) of Boolean; Obj : Arr; -- { dg-warning "Storage_Error" } begin diff --git a/gcc/testsuite/gnat.dg/object_overflow3.adb b/gcc/testsuite/gnat.dg/object_overflow3.adb index 5e27b4f..d3c0c17 100644 --- a/gcc/testsuite/gnat.dg/object_overflow3.adb +++ b/gcc/testsuite/gnat.dg/object_overflow3.adb @@ -1,10 +1,12 @@ -- { dg-do compile } +with Interfaces.C; use Interfaces.C; + procedure Object_Overflow3 is procedure Proc (x : Boolean) is begin null; end; - type Arr is array(0 .. Long_Integer'Last) of Boolean; + type Arr is array(0 .. ptrdiff_t'Last) of Boolean; type Rec is record A : Arr; diff --git a/gcc/testsuite/gnat.dg/object_overflow4.adb b/gcc/testsuite/gnat.dg/object_overflow4.adb index 643989d..0e320e2 100644 --- a/gcc/testsuite/gnat.dg/object_overflow4.adb +++ b/gcc/testsuite/gnat.dg/object_overflow4.adb @@ -1,14 +1,16 @@ -- { dg-do compile } +with Interfaces.C; use Interfaces.C; + procedure Object_Overflow4 is procedure Proc (x : Integer) is begin null; end; - type Index is new Long_Integer range 0 .. Long_Integer'Last; + type Index_T is new ptrdiff_t range 0 .. ptrdiff_t'Last; - type Arr is array(Index range <>) of Integer; + type Arr is array(Index_T range <>) of Integer; - type Rec (Size: Index := 6) is record -- { dg-warning "Storage_Error" } + type Rec (Size: Index_T := 6) is record -- { dg-warning "Storage_Error" } A: Arr (0..Size); end record; diff --git a/gcc/testsuite/gnat.dg/object_overflow5.adb b/gcc/testsuite/gnat.dg/object_overflow5.adb index 4a4f6cf..42d00b2 100644 --- a/gcc/testsuite/gnat.dg/object_overflow5.adb +++ b/gcc/testsuite/gnat.dg/object_overflow5.adb @@ -1,14 +1,16 @@ -- { dg-do compile } +with Interfaces.C; use Interfaces.C; + procedure Object_Overflow5 is procedure Proc (c : Character) is begin null; end; - type Index is new Long_Integer range 0 .. Long_Integer'Last; + type Index_T is new ptrdiff_t range 0 .. ptrdiff_t'Last; - type Arr is array(Index range <>) of Character; + type Arr is array(Index_T range <>) of Character; - type Rec (Size: Index := 6) is record -- { dg-warning "Storage_Error" } + type Rec (Size: Index_T := 6) is record -- { dg-warning "Storage_Error" } A: Arr (0..Size); end record; |