From patchwork Thu Sep 19 13:28:19 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1164626 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-509286-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ekp/lsIg"; 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 46YyS91FWLz9s4Y for ; Thu, 19 Sep 2019 23:31:52 +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=e4aFOJpi3kebcx+BM/vSEtBgsna9pLAj8f7E6QN5CkgUM4FW4u QAXZKPQFodMf0PRnJZJPRUgPYys8CbXkAthoWRbqierLYzOrnJzY4N8In1Mfc/n0 4zazZ8muPXyXS1+i7LQVpX3mtTUDB8BpuTIfHugtQopVzV4Lmb4BXhq2w= 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=dYp+sACOMzOPhhtgW29irvutjxE=; b=ekp/lsIgk7tWTj/t7/z1 //nJ/Q2WqsL27aY+JsxOCfXKBGy/kWy6s/LKVDh+3XNunvLlCSsZFlGW2KRbhdGT dpgBrz05d8yK1QfxCKECdVWhFYY0DPv2lJP7UO76G8Y1GH13PInomN534BJY1mQi eKWpHRPx0aFIyUNapWgjciQ= Received: (qmail 4967 invoked by alias); 19 Sep 2019 13:28:52 -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 2429 invoked by uid 89); 19 Sep 2019 13:28:32 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, SPF_NEUTRAL autolearn=ham version=3.3.1 spammy=sloc, Sloc, withed, semantic X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (209.51.188.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 19 Sep 2019 13:28:30 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iAwTy-0001PV-Cn for gcc-patches@gcc.gnu.org; Thu, 19 Sep 2019 09:28:28 -0400 Received: from rock.gnat.com ([205.232.38.15]:48696) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1iAwTx-0001OV-RH for gcc-patches@gcc.gnu.org; Thu, 19 Sep 2019 09:28:26 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 12C335602D; Thu, 19 Sep 2019 09:28:20 -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 6boYXOWfvmpu; Thu, 19 Sep 2019 09:28:20 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id CEE135602A; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id CDE3F6B4; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Date: Thu, 19 Sep 2019 09:28:19 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix bogus "too late" error with nested generics and inlining Message-ID: <20190919132819.GA41877@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 205.232.38.15 X-IsSubscribed: yes This prevents the compiler from issuing a bogus error about a constant whose full declaration appears too late, if it is declared in a nested generic package and instantiated in another nested instantiation, when the instantiations are done in a unit withed from the main unit and containing an inlined subprogram, and cross-unit inlining is enabled. It turns out that, under these very peculiar conditions, the compiler ends up instantiating the body of the generic package twice, which leads to various semantic errors, in particular for declarations of constants. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-09-19 Eric Botcazou gcc/ada/ * sem_ch12.adb (Instantiate_Package_Body): Check that the body has not already been instantiated when the body of the parent was being loaded. gcc/testsuite/ * gnat.dg/inline21.adb, gnat.dg/inline21_g.ads, gnat.dg/inline21_h.adb, gnat.dg/inline21_h.ads, gnat.dg/inline21_q.ads: New testcase. --- gcc/ada/sem_ch12.adb +++ gcc/ada/sem_ch12.adb @@ -11442,6 +11442,68 @@ package body Sem_Ch12 is else Load_Parent_Of_Generic (Inst_Node, Specification (Gen_Decl), Body_Optional); + + -- Surprisingly enough, loading the body of the parent can cause + -- the body to be instantiated and the double instantiation needs + -- to be prevented in order to avoid giving bogus semantic errors. + + -- This case can occur because of the Collect_Previous_Instances + -- machinery of Load_Parent_Of_Generic, which will instantiate + -- bodies that are deemed to be ahead of the body of the parent + -- in the compilation unit. But the relative position of these + -- bodies is computed using the mere comparison of their Sloc. + + -- Now suppose that you have two generic packages G and H, with + -- G containing a mere instantiation of H: + + -- generic + -- package H is + + -- generic + -- package Nested_G is + -- ... + -- end Nested_G; + + -- end H; + + -- with H; + + -- generic + -- package G is + + -- package My_H is new H; + + -- end G; + + -- and a third package Q instantiating G and Nested_G: + + -- with G; + + -- package Q is + + -- package My_G is new G; + + -- package My_Nested_G is new My_G.My_H.Nested_G; + + -- end Q; + + -- The body to be instantiated is that of My_Nested_G and its + -- parent is the instance My_G.My_H. This latter instantiation + -- is done when My_G is analyzed, i.e. after the declarations + -- of My_G and My_Nested_G have been parsed; as a result, the + -- Sloc of My_G.My_H is greater than the Sloc of My_Nested_G. + + -- Therefore loading the body of My_G.My_H will cause the body + -- of My_Nested_G to be instantiated because it is deemed to be + -- ahead of My_G.My_H. This means that Load_Parent_Of_Generic + -- will again be invoked on My_G.My_H, but this time with the + -- Collect_Previous_Instances machinery disabled, so there is + -- no endless mutual recursion and things are done in order. + + if Present (Corresponding_Body (Instance_Spec (Inst_Node))) then + goto Leave; + end if; + Gen_Body_Id := Corresponding_Body (Gen_Decl); end if; end if; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/inline21.adb @@ -0,0 +1,9 @@ +-- { dg-compile } +-- { dg-options "-O -gnatn" } + +with Inline21_Q; + +procedure Inline21 is +begin + Inline21_Q.My_Nested_G.Proc; +end; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/inline21_g.ads @@ -0,0 +1,8 @@ +with Inline21_H; + +generic +package Inline21_G is + + package My_H is new Inline21_H; + +end Inline21_G; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/inline21_h.adb @@ -0,0 +1,14 @@ +package body Inline21_H is + + package body Nested_G is + + C : constant Integer := 0; + + procedure Proc is + begin + null; + end; + + end Nested_G; + +end Inline21_H; \ No newline at end of file --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/inline21_h.ads @@ -0,0 +1,10 @@ +generic +package Inline21_H is + + generic + package Nested_G is + procedure Proc; + pragma Inline (Proc); + end Nested_G; + +end Inline21_H; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/inline21_q.ads @@ -0,0 +1,9 @@ +with Inline21_G; + +package Inline21_Q is + + package My_G is new Inline21_G; + + package My_Nested_G is new My_G.My_H.Nested_G; + +end Inline21_Q;