From patchwork Thu Jun 17 15:24:44 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56061 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]) by ozlabs.org (Postfix) with SMTP id A3C97B7D83 for ; Fri, 18 Jun 2010 01:24:37 +1000 (EST) Received: (qmail 28650 invoked by alias); 17 Jun 2010 15:24:35 -0000 Received: (qmail 28633 invoked by uid 22791); 17 Jun 2010 15:24:34 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 17 Jun 2010 15:24:29 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id BC1E9CB0202; Thu, 17 Jun 2010 17:24:34 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id QCr0SjnF3Qdj; Thu, 17 Jun 2010 17:24:34 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id A891DCB01EA; Thu, 17 Jun 2010 17:24:34 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B53D3D9AB0; Thu, 17 Jun 2010 17:24:44 +0200 (CEST) Date: Thu, 17 Jun 2010 17:24:44 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Freezing the designated type of an access_to_subprogram_type Message-ID: <20100617152444.GA14164@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 A type cannot be frozen if it is not yet fully defined. For the designated type of an access_to_subprogram_type, all the types in its profile must be fully defined before the subprogram type itself can be frozen. The following must compile quietly: --- with Statefull_Artifact_G; procedure Main is type State is (CREATED, REVIEWED); type Activity is (REVIEW); package Requirement is new Statefull_Artifact_G (State, Activity, State'First); begin null; end Main; --- with Ada.Finalization; generic type State is (<>); type Activity is (<>); Initial_State : State := State'First; package Statefull_Artifact_G is type Statefull_Artifact is abstract new Ada.Finalization.Controlled with private; type Guard is access function (This : Statefull_Artifact'Class) return Boolean; private type State_Ref is access all State; type Guard_Map is array (State, Activity) of Guard; Guards : Guard_Map := (others => (others => null)); type Statefull_Artifact is abstract new Ada.Finalization.Controlled with record Current_State : State_Ref := null; end record; end Statefull_Artifact_G; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-17 Ed Schonberg * freeze.adb (Freeze_Expression): The designated type of an access_to_suprogram type can only be frozen if all types in its profile are fully defined. Index: freeze.adb =================================================================== --- freeze.adb (revision 160905) +++ freeze.adb (working copy) @@ -5306,6 +5306,26 @@ package body Freeze is return True; end; + -- For the designated type of an access to subprogram. all types in + -- the profile must be fully defined. + + elsif Ekind (T) = E_Subprogram_Type then + declare + F : Entity_Id; + + begin + F := First_Formal (T); + while Present (F) loop + if not Is_Fully_Defined (Etype (F)) then + return False; + end if; + + Next_Formal (F); + end loop; + + return Is_Fully_Defined (Etype (T)); + end; + else return not Is_Private_Type (T) or else Present (Full_View (Base_Type (T)));