From 0d9ee815f945d0b9d42bf8c069b4c506bd5febf0 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Feb 2018 23:26:08 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257773 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 28 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/array11.adb | 10 ++++---- gcc/testsuite/gnat.dg/{dispatch1.adb => disp1.adb} | 5 ++-- .../gnat.dg/{dispatch1_p.ads => disp1_pkg.ads} | 6 +++-- gcc/testsuite/gnat.dg/{dispatch2.adb => disp2.adb} | 5 ++-- .../gnat.dg/{dispatch2_p.adb => disp2_pkg.adb} | 7 +++--- .../gnat.dg/{dispatch2_p.ads => disp2_pkg.ads} | 9 ++++--- .../{generic_dispatch.adb => generic_disp.adb} | 7 +++--- ...generic_dispatch_p.adb => generic_disp_pkg.adb} | 8 ++++--- ...generic_dispatch_p.ads => generic_disp_pkg.ads} | 5 ++-- gcc/testsuite/gnat.dg/null_pointer_deref1.adb | 2 +- gcc/testsuite/gnat.dg/null_pointer_deref2.adb | 2 +- gcc/testsuite/gnat.dg/object_overflow1.adb | 4 +++- gcc/testsuite/gnat.dg/object_overflow2.adb | 4 +++- gcc/testsuite/gnat.dg/object_overflow3.adb | 4 +++- gcc/testsuite/gnat.dg/object_overflow4.adb | 8 ++++--- gcc/testsuite/gnat.dg/object_overflow5.adb | 8 ++++--- 17 files changed, 87 insertions(+), 35 deletions(-) rename gcc/testsuite/gnat.dg/{dispatch1.adb => disp1.adb} (65%) rename gcc/testsuite/gnat.dg/{dispatch1_p.ads => disp1_pkg.ads} (63%) rename gcc/testsuite/gnat.dg/{dispatch2.adb => disp2.adb} (70%) rename gcc/testsuite/gnat.dg/{dispatch2_p.adb => disp2_pkg.adb} (72%) rename gcc/testsuite/gnat.dg/{dispatch2_p.ads => disp2_pkg.ads} (85%) rename gcc/testsuite/gnat.dg/{generic_dispatch.adb => generic_disp.adb} (57%) rename gcc/testsuite/gnat.dg/{generic_dispatch_p.adb => generic_disp_pkg.adb} (64%) rename gcc/testsuite/gnat.dg/{generic_dispatch_p.ads => generic_disp_pkg.ads} (90%) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9a156a6abb5..f3b1f9bccbf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,31 @@ +2018-02-16 Eric Botcazou + + 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 PR ipa/84425 diff --git a/gcc/testsuite/gnat.dg/array11.adb b/gcc/testsuite/gnat.dg/array11.adb index 7be61c4b631..aab73470092 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 similarity index 65% rename from gcc/testsuite/gnat.dg/dispatch1.adb rename to gcc/testsuite/gnat.dg/disp1.adb index 28e97e6e7e7..2fcefeafb42 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 similarity index 63% rename from gcc/testsuite/gnat.dg/dispatch1_p.ads rename to gcc/testsuite/gnat.dg/disp1_pkg.ads index 73de627516a..4d80e7655e1 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 similarity index 70% rename from gcc/testsuite/gnat.dg/dispatch2.adb rename to gcc/testsuite/gnat.dg/disp2.adb index ed57b13359e..2e1e6226080 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 similarity index 72% rename from gcc/testsuite/gnat.dg/dispatch2_p.adb rename to gcc/testsuite/gnat.dg/disp2_pkg.adb index 243c3ca977a..ed460ec453f 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 similarity index 85% rename from gcc/testsuite/gnat.dg/dispatch2_p.ads rename to gcc/testsuite/gnat.dg/disp2_pkg.ads index e7852b446b5..0b4903abe34 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 similarity index 57% rename from gcc/testsuite/gnat.dg/generic_dispatch.adb rename to gcc/testsuite/gnat.dg/generic_disp.adb index a22e495f451..2f828ff1b1b 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 similarity index 64% rename from gcc/testsuite/gnat.dg/generic_dispatch_p.adb rename to gcc/testsuite/gnat.dg/generic_disp_pkg.adb index 7a4bbbd8a2b..b3aeb3ff078 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 similarity index 90% rename from gcc/testsuite/gnat.dg/generic_dispatch_p.ads rename to gcc/testsuite/gnat.dg/generic_disp_pkg.ads index fe6115dd9c7..5be54921d83 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 6e7bf14e5df..ec7f9460559 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 63e2dd11f39..284762216c5 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 ba7f657e710..d972f24a1fe 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 9601c563b2a..a429291e80a 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 5e27b4f0d81..d3c0c17c57d 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 643989d348c..0e320e265ad 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 4a4f6cfe30e..42d00b24b95 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; -- 2.11.4.GIT