From patchwork Wed Sep 6 12:58:33 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810575 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-461602-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="BTX+z3cQ"; 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 3xnNtt0K49z9sBd for ; Wed, 6 Sep 2017 22:58:45 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=WLKK2SuIYVu0R+mpfiGIrcOkfo/g0RAJdlr7v4R22BiRISJFLC 39MRp7bEVK2rPCsn+NGxXPb3lsPZ2QNtyCkzm/mvx8X9gXbjAet9MrL5zmWvg5mm CfiqQE9CGJAbAu4FQiY1oK0Tv9gA8KJNj21hz6raEV1MFCclVPlCOTFUA= 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:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=nKalMK6QZaH0gkDNbBTPc1xFYh8=; b=BTX+z3cQgsIhiveLQ3w+ 86qSePTFnYU5kdv8m8pLbmn+rTCM9t+vKIX36JU4CbyZwnTWL41OFjZYNFY00uj0 XWI1zKbzxRpd0jsEzux8pLySdUYHcQeoAUeQkrqNeop3LuJIuGnLkdwBSdVOCqju 9EqpIt59m14Wb2G21BaMUBY= Received: (qmail 69504 invoked by alias); 6 Sep 2017 12:58:37 -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 69483 invoked by uid 89); 6 Sep 2017 12:58:36 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Hx-languages-length:2942, 105313 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 06 Sep 2017 12:58:35 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7C2B556424; Wed, 6 Sep 2017 08:58:33 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 8qT+qqC4WMI7; Wed, 6 Sep 2017 08:58:33 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 69C9556421; Wed, 6 Sep 2017 08:58:33 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 6612C4AC; Wed, 6 Sep 2017 08:58:33 -0400 (EDT) Date: Wed, 6 Sep 2017 08:58:33 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Spurious warning in formal package when use clause is present. Message-ID: <20170906125833.GA117502@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch removes a spurious style warning on an operator declared in a generic package when the package is used as a formal of a generic subprogram, and the subprogream body includes a use clause on that package. The following must compile quietly: gcc -c -gnatyO generic_test.adb --- with Generic_2; procedure Generic_Test is generic with package P_1 is new Generic_2 (<>); procedure S_1_G; procedure S_1_G is use P_1; begin null; end S_1_G; pragma Unreferenced (S_1_G); begin null; end Generic_Test; --- with Dummy; pragma Unreferenced (Dummy); with Generic_1; generic package Generic_2 is package P_1 is new Generic_1 (T_1 => Natural); end Generic_2; --- generic type T_1 is limited private; package Generic_1 is private type T_2 is record X : T_1; end record; function "=" (Left, Right : T_2) return Boolean is (True); end Generic_1; -- package Dummy is generic type T is range <>; package Dummy is function Foo (Of_Image : String) return T renames T'Value; end Dummy; end Dummy; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Ed Schonberg * sem_aux.adb (Is_Geeric_Formal): Handle properly formal packages. * sem_ch3.adb (Analyze_Declarations): In a generic subprogram body. do not freeze the formals of the generic unit. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 251789) +++ sem_ch3.adb (working copy) @@ -2649,9 +2649,27 @@ -- in order to perform visibility checks on delayed aspects. Adjust_Decl; - Freeze_All (First_Entity (Current_Scope), Decl); - Freeze_From := Last_Entity (Current_Scope); + -- If the current scope is a generic subprogram body. skip + -- the generic formal parameters that are not frozen here. + + if Is_Subprogram (Current_Scope) + and then Nkind (Unit_Declaration_Node (Current_Scope)) + = N_Generic_Subprogram_Declaration + and then Present (First_Entity (Current_Scope)) + then + while Is_Generic_Formal (Freeze_From) loop + Freeze_From := Next_Entity (Freeze_From); + end loop; + + Freeze_All (Freeze_From, Decl); + Freeze_From := Last_Entity (Current_Scope); + + else + Freeze_All (First_Entity (Current_Scope), Decl); + Freeze_From := Last_Entity (Current_Scope); + end if; + -- Current scope is a package specification elsif Scope (Current_Scope) /= Standard_Standard Index: sem_aux.adb =================================================================== --- sem_aux.adb (revision 251753) +++ sem_aux.adb (working copy) @@ -1053,9 +1053,13 @@ return Nkind_In (Kind, N_Formal_Object_Declaration, - N_Formal_Package_Declaration, N_Formal_Type_Declaration) - or else Is_Formal_Subprogram (E); + or else Is_Formal_Subprogram (E) + + or else + (Ekind (E) = E_Package + and then Nkind (Original_Node (Unit_Declaration_Node (E))) = + N_Formal_Package_Declaration); end if; end Is_Generic_Formal;