From patchwork Wed Nov 18 10:11:00 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 545943 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 E969D1402B7 for ; Wed, 18 Nov 2015 21:11:16 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=q2rxSBSL; dkim-atps=neutral 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=GVSFWEYtX0+G6JyoOaB2rGnt0GN5pvaiVUapDlRH9b2pLmOLK+ tazSjLz+K0CeGqKYGc0hhmmpumP85k+hzk5qe0HlblqBKaA2ZjpcMFHmKkAFtY6K KwiopY2pqO+Wjh+n8FcAPfgXHHJX/4VsXIe0JrOPxyMFdeE3e1APhTX7o= 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=YvfJQHN28SaNDWfCQk5Afu+SjXI=; b=q2rxSBSLym1TQKhLVitn jhHzAjXswIU9Wt0QzyFxy7VdPmcFq4HNb282zRLXI4hOc5p49EHVI8ZlS99p7pDf 6pBq4RXES8ZZRf+JKlbvt0OdAkK5quJGvOFFAdgaMXxWvxoY6z0T3biUC69lipZc Ay+19S97l1VEpMXqm0iShjo= Received: (qmail 38796 invoked by alias); 18 Nov 2015 10:11:05 -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 38720 invoked by uid 89); 18 Nov 2015 10:11:04 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.1 required=5.0 tests=BAYES_50, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 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 (AES256-SHA encrypted) ESMTPS; Wed, 18 Nov 2015 10:11:02 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7348E2952A; Wed, 18 Nov 2015 05:11:00 -0500 (EST) 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 VoJmdRlW6ShG; Wed, 18 Nov 2015 05:11:00 -0500 (EST) 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 635D229529; Wed, 18 Nov 2015 05:11:00 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 62C0836E; Wed, 18 Nov 2015 05:11:00 -0500 (EST) Date: Wed, 18 Nov 2015 05:11:00 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Crash on function returning limited view of class-wide type Message-ID: <20151118101100.GA53734@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) THis patch fixes a compiler crash on a function that returns a class-wide type, when the type is first obtained by means of a limited view. The following must compile quietly: --- with New_Network; limited with New_Network.Bus; package Topology is type Vertex (Nb_Terminals : New_Network.Terminal_Count) is tagged null record; function Get_Bus (Bus_Name : in New_Network.Name) return New_Network.Bus.Object'Class; end Topology; --- with New_Network.Bus; package body Topology is function Get_Bus (Bus_Name : in New_Network.Name) return New_Network.Bus.Object'Class is O : New_Network.Bus.Object; begin return O; end Get_Bus; end Topology; --- package New_Network is -- General dimensioning named numbers Max_Element_Terminals : constant := 6; -- Max number of terminals an element or a bus can have Max_Bus_Terminals : constant := 4; -- Max number of bonds a bus can have type Terminal_Count is range 0 .. Integer'Max (Max_Bus_Terminals, Max_Element_Terminals); subtype Name is String with Dynamic_Predicate => Name'Length > 0; end New_Network; --- with Topology; package New_Network.Bus is type Object is new Topology.Vertex (10) with null record; end New_Network.Bus; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-11-18 Ed Schonberg * sem_ch6.adb (Process_Formals): A function declaration that returns a class-wide type must have freeing deferred, so that it is not frozen before the class-wide type and its root type are frozen. This is significant when there may be a limited view of the class_wide type in another package. Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 230522) +++ sem_ch6.adb (working copy) @@ -10423,6 +10423,17 @@ if Nkind (Related_Nod) = N_Function_Specification then Analyze_Return_Type (Related_Nod); + + -- If return type is class-wide, subprogram freezing may be + -- delayed as well. + + if Is_Class_Wide_Type (Etype (Current_Scope)) + and then not Is_Thunk (Current_Scope) + and then Nkind (Unit_Declaration_Node (Current_Scope)) = + N_Subprogram_Declaration + then + Set_Has_Delayed_Freeze (Current_Scope); + end if; end if; -- Now set the kind (mode) of each formal