From patchwork Fri Feb 16 23:27:38 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 874700 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-473477-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="it9qhjTN"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zjq7Z6Dm2z9sBZ for ; Sat, 17 Feb 2018 10:27:52 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=hBEPp1hM0OZ3PGdI aStsQSNsDmHo/aFssd1f7CaGJkHZ69rbaSqqXWplcWMFtjINwaGFiBD1Q1oLQWhz 3ZUe4h8qgq+LyxGUZFwgFpLbmH35Uqfxq24Oh5+WFMXy9XJg+Xh0LU3ltqww7Q/s rgvTQbCzT2p0qbpjCD6mA5rLZAg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=XxeMP1ErANcp8EqZIlkIi4 TAZpw=; b=it9qhjTNwGWjrsAJDW9srHH6iXX2cuBQe/TFgOyyPKUXpMkaKvcEPA Lm1Ub4QisyWQeC4H4UKbvd3Nbc1Bov2+szBnsvGUIjYoJykOH8y8nUoa8g/zZPJe 9xm00YPbOxxTZx2zfXaHwrqoCe4dzKIRfRg9s5NDBVTIkjq8Qaljg= Received: (qmail 117561 invoked by alias); 16 Feb 2018 23:27:44 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 117552 invoked by uid 89); 16 Feb 2018 23:27:44 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-14.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=rise X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 16 Feb 2018 23:27:41 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 16D1C81A10 for ; Sat, 17 Feb 2018 00:27:39 +0100 (CET) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id yM1QaXa14sy7 for ; Sat, 17 Feb 2018 00:27:39 +0100 (CET) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id CF85B818D7 for ; Sat, 17 Feb 2018 00:27:38 +0100 (CET) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Minor tweaks to gnat.dg testsuite Date: Sat, 17 Feb 2018 00:27:38 +0100 Message-ID: <7034948.epMab8Doca@polaris> MIME-Version: 1.0 The gnat.dg testsuite contains a dozen of spurious failures on 64-bit Windows because of a couple of issues: the target is P64 and some patterns in filename give rise to warning at link time. Fixed thusly, applied to all active branches. 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. Index: gnat.dg/array11.adb =================================================================== --- gnat.dg/array11.adb (revision 257730) +++ gnat.dg/array11.adb (working copy) @@ -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; Index: gnat.dg/disp1.adb =================================================================== --- gnat.dg/disp1.adb (revision 257730) +++ gnat.dg/disp1.adb (working copy) @@ -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 Index: gnat.dg/disp1_pkg.ads =================================================================== --- gnat.dg/disp1_pkg.ads (revision 257730) +++ gnat.dg/disp1_pkg.ads (working copy) @@ -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; Index: gnat.dg/disp2.adb =================================================================== --- gnat.dg/disp2.adb (revision 257730) +++ gnat.dg/disp2.adb (working copy) @@ -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 Index: gnat.dg/disp2_pkg.adb =================================================================== --- gnat.dg/disp2_pkg.adb (revision 257730) +++ gnat.dg/disp2_pkg.adb (working copy) @@ -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; Index: gnat.dg/disp2_pkg.ads =================================================================== --- gnat.dg/disp2_pkg.ads (revision 257730) +++ gnat.dg/disp2_pkg.ads (working copy) @@ -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; + Index: gnat.dg/dispatch1.adb =================================================================== --- gnat.dg/dispatch1.adb (revision 257730) +++ gnat.dg/dispatch1.adb (nonexistent) @@ -1,9 +0,0 @@ --- { dg-do run } - -with dispatch1_p; use dispatch1_p; -procedure dispatch1 is - O : DT_I1; - Ptr : access I1'Class; -begin - Ptr := new I1'Class'(I1'Class (O)); -end; Index: gnat.dg/dispatch1_p.ads =================================================================== --- gnat.dg/dispatch1_p.ads (revision 257730) +++ gnat.dg/dispatch1_p.ads (nonexistent) @@ -1,4 +0,0 @@ -package dispatch1_p is - type I1 is interface; - type DT_I1 is new I1 with null record; -end; Index: gnat.dg/dispatch2.adb =================================================================== --- gnat.dg/dispatch2.adb (revision 257730) +++ gnat.dg/dispatch2.adb (nonexistent) @@ -1,10 +0,0 @@ --- { dg-do run } - -with dispatch2_p; use dispatch2_p; -procedure dispatch2 is - Obj : Object_Ptr := new Object; -begin - if Obj.Get_Ptr /= Obj.Impl_Of then - raise Program_Error; - end if; -end; Index: gnat.dg/dispatch2_p.adb =================================================================== --- gnat.dg/dispatch2_p.adb (revision 257730) +++ gnat.dg/dispatch2_p.adb (nonexistent) @@ -1,7 +0,0 @@ --- -package body dispatch2_p is - function Impl_Of (Self : access Object) return Object_Ptr is - begin - return Object_Ptr (Self); - end Impl_Of; -end; Index: gnat.dg/dispatch2_p.ads =================================================================== --- gnat.dg/dispatch2_p.ads (revision 257730) +++ gnat.dg/dispatch2_p.ads (nonexistent) @@ -1,8 +0,0 @@ -package dispatch2_p 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; Index: gnat.dg/generic_disp.adb =================================================================== --- gnat.dg/generic_disp.adb (revision 257730) +++ gnat.dg/generic_disp.adb (working copy) @@ -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; Index: gnat.dg/generic_disp_pkg.adb =================================================================== --- gnat.dg/generic_disp_pkg.adb (revision 257730) +++ gnat.dg/generic_disp_pkg.adb (working copy) @@ -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; Index: gnat.dg/generic_disp_pkg.ads =================================================================== --- gnat.dg/generic_disp_pkg.ads (revision 257730) +++ gnat.dg/generic_disp_pkg.ads (working copy) @@ -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; Index: gnat.dg/generic_dispatch.adb =================================================================== --- gnat.dg/generic_dispatch.adb (revision 257730) +++ gnat.dg/generic_dispatch.adb (nonexistent) @@ -1,9 +0,0 @@ --- { dg-do run } - -with generic_dispatch_p; use generic_dispatch_p; -procedure generic_dispatch is - I : aliased Integer := 0; - D : Iface'Class := Dispatching_Constructor (DT'Tag, I'access); -begin - null; -end generic_dispatch; Index: gnat.dg/generic_dispatch_p.adb =================================================================== --- gnat.dg/generic_dispatch_p.adb (revision 257730) +++ gnat.dg/generic_dispatch_p.adb (nonexistent) @@ -1,7 +0,0 @@ -package body generic_dispatch_p is - function Constructor (I : not null access Integer) return DT is - R : DT; - begin - return R; - end Constructor; -end; Index: gnat.dg/generic_dispatch_p.ads =================================================================== --- gnat.dg/generic_dispatch_p.ads (revision 257730) +++ gnat.dg/generic_dispatch_p.ads (nonexistent) @@ -1,13 +0,0 @@ -with Ada.Tags.Generic_Dispatching_Constructor; -package generic_dispatch_p is - type Iface is interface; - function Constructor (I : not null access Integer) return Iface is abstract; - function Dispatching_Constructor - is new Ada.Tags.Generic_Dispatching_Constructor - (T => Iface, - Parameters => Integer, - Constructor => Constructor); - type DT is new Iface with null record; - overriding - function Constructor (I : not null access Integer) return DT; -end; Index: gnat.dg/null_pointer_deref1.adb =================================================================== --- gnat.dg/null_pointer_deref1.adb (revision 257730) +++ gnat.dg/null_pointer_deref1.adb (working copy) @@ -17,5 +17,5 @@ procedure Null_Pointer_Deref1 is begin Data.all := 1; exception - when Constraint_Error | Storage_Error => null; + when others => null; end; Index: gnat.dg/null_pointer_deref2.adb =================================================================== --- gnat.dg/null_pointer_deref2.adb (revision 257730) +++ gnat.dg/null_pointer_deref2.adb (working copy) @@ -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 Index: gnat.dg/object_overflow1.adb =================================================================== --- gnat.dg/object_overflow1.adb (revision 257730) +++ gnat.dg/object_overflow1.adb (working copy) @@ -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 Index: gnat.dg/object_overflow2.adb =================================================================== --- gnat.dg/object_overflow2.adb (revision 257730) +++ gnat.dg/object_overflow2.adb (working copy) @@ -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 Index: gnat.dg/object_overflow3.adb =================================================================== --- gnat.dg/object_overflow3.adb (revision 257730) +++ gnat.dg/object_overflow3.adb (working copy) @@ -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; Index: gnat.dg/object_overflow4.adb =================================================================== --- gnat.dg/object_overflow4.adb (revision 257730) +++ gnat.dg/object_overflow4.adb (working copy) @@ -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; Index: gnat.dg/object_overflow5.adb =================================================================== --- gnat.dg/object_overflow5.adb (revision 257730) +++ gnat.dg/object_overflow5.adb (working copy) @@ -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;