From patchwork Wed Aug 21 08:31:42 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: 1150695 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-507424-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="S9hi5Ul4"; 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 46D1B37041z9sN4 for ; Wed, 21 Aug 2019 18:32:27 +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=JoQyQ3zu9g/7faR0GGRtNszr6efX4AYuuqOdTjZz//xmRZHm4Z cqHEj2z6Q6ZXINeh/U8H14dfrynndHdqWsZwyTa46HvG8h9wvej7TnBfF/XryvZn b3T0fGfDipwVNzc3OC5+IBssm/r/EV7CqBPtSHWzUQrH2Ro8Ruz9w1L5E= 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=R/ugLeU9PbHXu22QtH5chsIYhcI=; b=S9hi5Ul4SyIVOmuh+Fid OppZM0pjg17Kq212dMTXxFbGonTkZymtf7+oWtScxzdZz2+pZMEiR5p6NbTbemPz +T7pFKS54bJK6Xfi3/CEUt/8LfEP349OFQqle3MJ9Kax17Xq4ZkQlWIqxgVBBG1l 041Tx2GlVh0HFOeazrgS6Tg= Received: (qmail 95210 invoked by alias); 21 Aug 2019 08:31:45 -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 95131 invoked by uid 89); 21 Aug 2019 08:31:44 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=exp_util, H*Ad:U*ebotcazou 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, 21 Aug 2019 08:31:43 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 274FA1163F3; Wed, 21 Aug 2019 04:31:42 -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 4kI30LR2+1zQ; Wed, 21 Aug 2019 04:31:42 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 12D6F1163EA; Wed, 21 Aug 2019 04:31:42 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 11C12646; Wed, 21 Aug 2019 04:31:42 -0400 (EDT) Date: Wed, 21 Aug 2019 04:31:42 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix assertion failure on derived private protected type Message-ID: <20190821083141.GA71826@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This fixes an assertion failure on the instantiation of a generic package on a type derived from the private view of a protected type, ultimately caused by Finalize_Address returning Empty for the subtype built for the generic actual type of the instantiation. Finalize_Address has a special processing for untagged derivations of private views, but it would no longer trigger for the subtype because this subtype is now represented as a subtype of an implicit derived base type instead of as the derived type of an implicit subtype previously. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-08-21 Eric Botcazou gcc/ada/ * exp_util.adb (Finalize_Address): Deal consistently with subtypes of private protected types. gcc/testsuite/ * gnat.dg/prot9.adb, gnat.dg/prot9_gen.ads, gnat.dg/prot9_pkg1.ads, gnat.dg/prot9_pkg2.ads: New testcase. --- gcc/ada/exp_util.adb +++ gcc/ada/exp_util.adb @@ -5347,6 +5347,7 @@ package body Exp_Util is ---------------------- function Finalize_Address (Typ : Entity_Id) return Entity_Id is + Btyp : constant Entity_Id := Base_Type (Typ); Utyp : Entity_Id := Typ; begin @@ -5386,12 +5387,12 @@ package body Exp_Util is -- records do not automatically inherit operations, but maybe they -- should???) - if Is_Untagged_Derivation (Typ) then - if Is_Protected_Type (Typ) then - Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ))); + if Is_Untagged_Derivation (Btyp) then + if Is_Protected_Type (Btyp) then + Utyp := Corresponding_Record_Type (Root_Type (Btyp)); else - Utyp := Underlying_Type (Root_Type (Base_Type (Typ))); + Utyp := Underlying_Type (Root_Type (Btyp)); if Is_Protected_Type (Utyp) then Utyp := Corresponding_Record_Type (Utyp); --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot9.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } + +with Prot9_Gen; +with Prot9_Pkg1; + +procedure Prot9 is + package Dummy is new Prot9_Gen (Prot9_Pkg1.Prot_Type); +begin + null; +end Prot9; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot9_gen.ads @@ -0,0 +1,9 @@ +generic + type Field_Type is limited private; +package Prot9_Gen is + + type Field_Pointer is access all Field_Type; + + Pointer : Field_Pointer := new Field_Type; + +end Prot9_Gen; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot9_pkg1.ads @@ -0,0 +1,11 @@ +with Prot9_Pkg2; + +package Prot9_Pkg1 is + + type Prot_Type is limited private; + +private + + type Prot_Type is new Prot9_Pkg2.Prot_Type; + +end Prot9_Pkg1; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot9_pkg2.ads @@ -0,0 +1,16 @@ +with Ada.Containers.Doubly_Linked_Lists; + +package Prot9_Pkg2 is + + type Prot_type is limited private; + +private + + package My_Lists is new Ada.Containers.Doubly_Linked_Lists (Integer); + + protected type Prot_type is + private + L : My_Lists.List; + end Prot_type; + +end Prot9_Pkg2;