From patchwork Mon Aug 19 08:39:00 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: 1149113 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-507226-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="uTvibbVP"; 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 46BnTQ621Vz9sMr for ; Mon, 19 Aug 2019 18:41:30 +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=VBVXxs62PS0HKiePAKBUqYn9NX0fmNcqJzwf2vZQz1F/ii9wB0 5WAzCwKPRJfH1etSEcZ31hNdhMlt6Zwy9isNjLMoJA+jraYwlRhunGCC0d12Yujh TjoJiQf9ZAfSJ2UqQGzk1uUuqPwDBQYLR0CVGEZcZyY3Vg+c/ruQppc1c= 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=YDwNt3MxqE6ABdVpfg31dWV9R3o=; b=uTvibbVPz53VfqI32DxP IU2nb1xEW13+Kk2g6PGCtQNd51jL/Z23ZIdFQyg9NDS5s8E7osQjih0+LRW8UFIi 78FzNpSDJhcOh0X66PCd8OGo6rZcB2ldHSBgOlFd8RhvahhL0rn7ncCPpLg5kuJX 2zN8zVbeyMMT50/MM8AZwdc= Received: (qmail 116300 invoked by alias); 19 Aug 2019 08:39:11 -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 116154 invoked by uid 89); 19 Aug 2019 08:39:10 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.3 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, SPF_NEUTRAL autolearn=ham version=3.3.1 spammy=clearing, cleared, exp_dist, fallout 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; Mon, 19 Aug 2019 08:39:08 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hzdBx-0007us-90 for gcc-patches@gcc.gnu.org; Mon, 19 Aug 2019 04:39:07 -0400 Received: from rock.gnat.com ([205.232.38.15]:53929) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hzdBx-0007sD-21 for gcc-patches@gcc.gnu.org; Mon, 19 Aug 2019 04:39:05 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C88505604D; Mon, 19 Aug 2019 04:39:00 -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 I9hLjxVM8vfY; Mon, 19 Aug 2019 04:39:00 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id B780911619A; Mon, 19 Aug 2019 04:39:00 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id B32FE6AB; Mon, 19 Aug 2019 04:39:00 -0400 (EDT) Date: Mon, 19 Aug 2019 04:39:00 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix incorrect stub generation for types in instances Message-ID: <20190819083900.GA33425@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 fixes a fallout of a recent change clearing the Is_Generic_Actual_Type on the implicit full view of a private actual type in an instance. This flag is used to help disambiguating formal types instantiated on the same actual type within an instance, but it should be cleared outside the instance to let the usual disambiguation rules apply again to these types outside the instance. This in particular means that Exp_Dist cannot rely on it to detect subtypes representing generic actual types, hence the need for the new predicate. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-08-19 Eric Botcazou gcc/ada/ * exp_dist.adb (Is_Generic_Actual_Subtype): New predicate. (Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call): Use it instead of Is_Generic_Actual_Type flag to detect subtypes representing generic actual types. --- gcc/ada/exp_dist.adb +++ gcc/ada/exp_dist.adb @@ -8201,6 +8201,12 @@ package body Exp_Dist is -- type from Interfaces, or the smallest floating point type from -- Standard whose range encompasses that of Typ. + function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean; + -- Return true if Typ is a subtype representing a generic formal type + -- as a subtype of the actual type in an instance. This is needed to + -- recognize these subtypes because the Is_Generic_Actual_Type flag + -- can only be relied upon within the instance. + function Make_Helper_Function_Name (Loc : Source_Ptr; Typ : Entity_Id; @@ -8453,7 +8459,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -9262,7 +9268,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -10116,7 +10122,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -10901,6 +10907,30 @@ package body Exp_Dist is end Find_Numeric_Representation; + --------------------------------- + -- Is_Generic_Actual_Subtype -- + --------------------------------- + + function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean is + begin + if Is_Itype (Typ) + and then Present (Associated_Node_For_Itype (Typ)) + then + declare + N : constant Node_Id := Associated_Node_For_Itype (Typ); + begin + if Nkind (N) = N_Subtype_Declaration + and then Nkind (Parent (N)) = N_Package_Specification + and then Is_Generic_Instance (Scope_Of_Spec (Parent (N))) + then + return True; + end if; + end; + end if; + + return False; + end Is_Generic_Actual_Subtype; + --------------------------- -- Append_Array_Traversal -- ---------------------------