Patch Detail
get:
Show a patch.
patch:
Update a patch.
put:
Update a patch.
GET /api/patches/811451/?format=api
{ "id": 811451, "url": "http://patchwork.ozlabs.org/api/patches/811451/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/patch/20170908100306.GA106924@adacore.com/", "project": { "id": 17, "url": "http://patchwork.ozlabs.org/api/projects/17/?format=api", "name": "GNU Compiler Collection", "link_name": "gcc", "list_id": "gcc-patches.gcc.gnu.org", "list_email": "gcc-patches@gcc.gnu.org", "web_url": null, "scm_url": null, "webscm_url": null, "list_archive_url": "", "list_archive_url_format": "", "commit_url_format": "" }, "msgid": "<20170908100306.GA106924@adacore.com>", "list_archive_url": null, "date": "2017-09-08T10:03:06", "name": "[Ada] Fix crash on expression function that is a completion", "commit_ref": null, "pull_url": null, "state": "new", "archived": false, "hash": "e9e3c4108c40043dc6fd6d7fef6e0cd5dad39b13", "submitter": { "id": 4418, "url": "http://patchwork.ozlabs.org/api/people/4418/?format=api", "name": "Arnaud Charlet", "email": "charlet@adacore.com" }, "delegate": null, "mbox": "http://patchwork.ozlabs.org/project/gcc/patch/20170908100306.GA106924@adacore.com/mbox/", "series": [ { "id": 2167, "url": "http://patchwork.ozlabs.org/api/series/2167/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/list/?series=2167", "date": "2017-09-08T10:03:06", "name": "[Ada] Fix crash on expression function that is a completion", "version": 1, "mbox": "http://patchwork.ozlabs.org/series/2167/mbox/" } ], "comments": "http://patchwork.ozlabs.org/api/patches/811451/comments/", "check": "pending", "checks": "http://patchwork.ozlabs.org/api/patches/811451/checks/", "tags": {}, "related": [], "headers": { "Return-Path": "<gcc-patches-return-461715-incoming=patchwork.ozlabs.org@gcc.gnu.org>", "X-Original-To": "incoming@patchwork.ozlabs.org", "Delivered-To": [ "patchwork-incoming@bilbo.ozlabs.org", "mailing list gcc-patches@gcc.gnu.org" ], "Authentication-Results": [ "ozlabs.org;\n\tspf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org\n\t(client-ip=209.132.180.131; helo=sourceware.org;\n\tenvelope-from=gcc-patches-return-461715-incoming=patchwork.ozlabs.org@gcc.gnu.org;\n\treceiver=<UNKNOWN>)", "ozlabs.org; dkim=pass (1024-bit key;\n\tunprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org\n\theader.b=\"SpZMq4SD\"; dkim-atps=neutral", "sourceware.org; auth=none" ], "Received": [ "from sourceware.org (server1.sourceware.org [209.132.180.131])\n\t(using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256\n\tbits)) (No client certificate requested)\n\tby ozlabs.org (Postfix) with ESMTPS id 3xpXvv3cpKz9s7C\n\tfor <incoming@patchwork.ozlabs.org>;\n\tFri, 8 Sep 2017 20:03:39 +1000 (AEST)", "(qmail 68433 invoked by alias); 8 Sep 2017 10:03:15 -0000", "(qmail 68060 invoked by uid 89); 8 Sep 2017 10:03:14 -0000", "from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by\n\tsourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP;\n\tFri, 08 Sep 2017 10:03:07 +0000", "from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id 51B415619D;\n\tFri, 8 Sep 2017 06:03:06 -0400 (EDT)", "from rock.gnat.com ([127.0.0.1])\tby localhost (rock.gnat.com\n\t[127.0.0.1]) (amavisd-new, port 10024)\twith LMTP id\n\t9zyiE51AMjBy; Fri, 8 Sep 2017 06:03:06 -0400 (EDT)", "from tron.gnat.com (tron.gnat.com\n\t[IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294])\tby rock.gnat.com\n\t(Postfix) with ESMTP id 3F58C56126;\n\tFri, 8 Sep 2017 06:03:06 -0400 (EDT)", "by tron.gnat.com (Postfix, from userid 4192)\tid 3E4ED505;\n\tFri, 8 Sep 2017 06:03:06 -0400 (EDT)" ], "DomainKey-Signature": "a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; q=dns;\n\ts=default; b=QKjqdKvgeQsZXQlB0WsDV54abqvKmZGtOSjw05IiOlRQrGM7KZ\n\tmqTXyIs2V59ETpjrnT/WM7EJZVZvQ95ecFJ3KSlu77yXd7aZBTjrsU0aO51EIs/9\n\t+02mvAg46tFk8fK02jQPPNii0Al8XRPNGvgWSEN0MdECKxggMBVqtSNio=", "DKIM-Signature": "v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; s=\n\tdefault; bh=3pqW3J2JzKNKmUVerPCj06aMH+Q=; b=SpZMq4SDROS2HHdG3cZ+\n\t3uB9+c4/RqYy0WIBLcoCYIc/CYvY908IyuDstgVWZtdAK9yf/FDcxDmK1VUnCxmv\n\tXzrVez8M3WXupgsIfUgCcpZKQ2kZ+Iyr7aL4Xxo+hzNS8rvtcBLtXuGKIFmFHjDh\n\to8KiAAHW9Drm/Z/PPrrPanc=", "Mailing-List": "contact gcc-patches-help@gcc.gnu.org; run by ezmlm", "Precedence": "bulk", "List-Id": "<gcc-patches.gcc.gnu.org>", "List-Unsubscribe": "<mailto:gcc-patches-unsubscribe-incoming=patchwork.ozlabs.org@gcc.gnu.org>", "List-Archive": "<http://gcc.gnu.org/ml/gcc-patches/>", "List-Post": "<mailto:gcc-patches@gcc.gnu.org>", "List-Help": "<mailto:gcc-patches-help@gcc.gnu.org>", "Sender": "gcc-patches-owner@gcc.gnu.org", "X-Virus-Found": "No", "X-Spam-SWARE-Status": "No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2,\n\tGIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE,\n\tSPF_PASS autolearn=ham version=3.3.2 spammy=", "X-HELO": "rock.gnat.com", "Date": "Fri, 8 Sep 2017 06:03:06 -0400", "From": "Arnaud Charlet <charlet@adacore.com>", "To": "gcc-patches@gcc.gnu.org", "Cc": "Eric Botcazou <ebotcazou@adacore.com>", "Subject": "[Ada] Fix crash on expression function that is a completion", "Message-ID": "<20170908100306.GA106924@adacore.com>", "MIME-Version": "1.0", "Content-Type": "multipart/mixed; boundary=\"sdtB3X0nJg68CQEu\"", "Content-Disposition": "inline", "User-Agent": "Mutt/1.5.23 (2014-03-12)" }, "content": "This change fixes a crash on an expression function which is the completion of\na previous declaration, when the type of the expression is a record type which\ncontains private components.\n\nSuch a code is illegal as per AI12-0103, which says that expression functions\nthat are a completion freeze their expression (but don't freeze anything else),\nand must therefore be properly rejected.\n\nCompiling the following package:\n\npackage P is\n\n type Cursor is private;\n\n package Nested is\n\n type Rec is record\n C : Cursor;\n end record;\n\n function F (R : Rec) return Rec;\n\n private\n\n function F (R : Rec) return Rec is (R);\n\n end Nested;\n\nprivate\n\n type Cursor is null record;\n\nend P;\n\nmust yield:\n\np.ads:15:43: premature usage of incomplete type \"Rec\" defined at line 7\np.ads:15:43: type \"Rec\" has private component\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-08 Eric Botcazou <ebotcazou@adacore.com>\n\n\t* sem_ch6.adb (Freeze_Expr_Types): Really freeze\n\tall the types that are referenced by the expression.\n\t(Analyze_Expression_Function): Call Freeze_Expr_Types for\n\ta completion instead of manually freezing the type of the\n\texpression.\n\t(Analyze_Subprogram_Body_Helper): Do not call Freeze_Expr_Types here.", "diff": "Index: sem_ch6.adb\n===================================================================\n--- sem_ch6.adb\t(revision 251875)\n+++ sem_ch6.adb\t(working copy)\n@@ -267,18 +267,214 @@\n LocX : constant Source_Ptr := Sloc (Expr);\n Spec : constant Node_Id := Specification (N);\n \n+ procedure Freeze_Expr_Types (Spec_Id : Entity_Id);\n+ -- N is an expression function that is a completion and Spec_Id its\n+ -- defining entity. Freeze before N all the types referenced by the\n+ -- expression of the function.\n+\n+ -----------------------\n+ -- Freeze_Expr_Types --\n+ -----------------------\n+\n+ procedure Freeze_Expr_Types (Spec_Id : Entity_Id) is\n+ function Cloned_Expression return Node_Id;\n+ -- Build a duplicate of the expression of the return statement that\n+ -- has no defining entities shared with the original expression.\n+\n+ function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result;\n+ -- Freeze all types referenced in the subtree rooted at Node\n+\n+ -----------------------\n+ -- Cloned_Expression --\n+ -----------------------\n+\n+ function Cloned_Expression return Node_Id is\n+ function Clone_Id (Node : Node_Id) return Traverse_Result;\n+ -- Tree traversal routine that clones the defining identifier of\n+ -- iterator and loop parameter specification nodes.\n+\n+ ----------------\n+ -- Check_Node --\n+ ----------------\n+\n+ function Clone_Id (Node : Node_Id) return Traverse_Result is\n+ begin\n+ if Nkind_In (Node, N_Iterator_Specification,\n+ N_Loop_Parameter_Specification)\n+ then\n+ Set_Defining_Identifier (Node,\n+ New_Copy (Defining_Identifier (Node)));\n+ end if;\n+\n+ return OK;\n+ end Clone_Id;\n+\n+ procedure Clone_Def_Ids is new Traverse_Proc (Clone_Id);\n+\n+ -- Local variable\n+\n+ Dup_Expr : constant Node_Id := New_Copy_Tree (Expr);\n+\n+ -- Start of processing for Cloned_Expression\n+\n+ begin\n+ -- We must duplicate the expression with semantic information to\n+ -- inherit the decoration of global entities in generic instances.\n+ -- Set the parent of the new node to be the parent of the original\n+ -- to get the proper context, which is needed for complete error\n+ -- reporting and for semantic analysis.\n+\n+ Set_Parent (Dup_Expr, Parent (Expr));\n+\n+ -- Replace the defining identifier of iterators and loop param\n+ -- specifications by a clone to ensure that the cloned expression\n+ -- and the original expression don't have shared identifiers;\n+ -- otherwise, as part of the preanalysis of the expression, these\n+ -- shared identifiers may be left decorated with itypes which\n+ -- will not be available in the tree passed to the backend.\n+\n+ Clone_Def_Ids (Dup_Expr);\n+\n+ return Dup_Expr;\n+ end Cloned_Expression;\n+\n+ ----------------------\n+ -- Freeze_Type_Refs --\n+ ----------------------\n+\n+ function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result is\n+\n+ procedure Check_And_Freeze_Type (Typ : Entity_Id);\n+ -- Check that Typ is fully declared and freeze it if so\n+\n+ ---------------------------\n+ -- Check_And_Freeze_Type --\n+ ---------------------------\n+\n+ procedure Check_And_Freeze_Type (Typ : Entity_Id) is\n+ begin\n+ -- Skip Itypes created by the preanalysis\n+\n+ if Is_Itype (Typ)\n+ and then Scope_Within_Or_Same (Scope (Typ), Spec_Id)\n+ then\n+ return;\n+ end if;\n+\n+ -- This provides a better error message than generating\n+ -- primitives whose compilation fails much later. Refine\n+ -- the error message if possible.\n+\n+ Check_Fully_Declared (Typ, Node);\n+\n+ if Error_Posted (Node) then\n+ if Has_Private_Component (Typ)\n+ and then not Is_Private_Type (Typ)\n+ then\n+ Error_Msg_NE\n+ (\"\\type& has private component\", Node, Typ);\n+ end if;\n+\n+ else\n+ Freeze_Before (N, Typ);\n+ end if;\n+ end Check_And_Freeze_Type;\n+\n+ -- Start of processing for Freeze_Type_Refs\n+\n+ begin\n+ -- Check that a type referenced by an entity can be frozen\n+\n+ if Is_Entity_Name (Node) and then Present (Entity (Node)) then\n+ Check_And_Freeze_Type (Etype (Entity (Node)));\n+\n+ -- Check that the enclosing record type can be frozen\n+\n+ if Ekind_In (Entity (Node), E_Component, E_Discriminant) then\n+ Check_And_Freeze_Type (Scope (Entity (Node)));\n+ end if;\n+\n+ -- Freezing an access type does not freeze the designated type,\n+ -- but freezing conversions between access to interfaces requires\n+ -- that the interface types themselves be frozen, so that dispatch\n+ -- table entities are properly created.\n+\n+ -- Unclear whether a more general rule is needed ???\n+\n+ elsif Nkind (Node) = N_Type_Conversion\n+ and then Is_Access_Type (Etype (Node))\n+ and then Is_Interface (Designated_Type (Etype (Node)))\n+ then\n+ Check_And_Freeze_Type (Designated_Type (Etype (Node)));\n+ end if;\n+\n+ -- No point in posting several errors on the same expression\n+\n+ if Serious_Errors_Detected > 0 then\n+ return Abandon;\n+ else\n+ return OK;\n+ end if;\n+ end Freeze_Type_Refs;\n+\n+ procedure Freeze_References is new Traverse_Proc (Freeze_Type_Refs);\n+\n+ -- Local variables\n+\n+ Saved_First_Entity : constant Entity_Id := First_Entity (Spec_Id);\n+ Saved_Last_Entity : constant Entity_Id := Last_Entity (Spec_Id);\n+ Dup_Expr : constant Node_Id := Cloned_Expression;\n+\n+ -- Start of processing for Freeze_Expr_Types\n+\n+ begin\n+ -- Preanalyze a duplicate of the expression to have available the\n+ -- minimum decoration needed to locate referenced unfrozen types\n+ -- without adding any decoration to the function expression. This\n+ -- preanalysis is performed with errors disabled to avoid reporting\n+ -- spurious errors on Ghost entities (since the expression is not\n+ -- fully analyzed).\n+\n+ Push_Scope (Spec_Id);\n+ Install_Formals (Spec_Id);\n+ Ignore_Errors_Enable := Ignore_Errors_Enable + 1;\n+\n+ Preanalyze_Spec_Expression (Dup_Expr, Etype (Spec_Id));\n+\n+ Ignore_Errors_Enable := Ignore_Errors_Enable - 1;\n+ End_Scope;\n+\n+ -- Restore certain attributes of Spec_Id since the preanalysis may\n+ -- have introduced itypes to this scope, thus modifying attributes\n+ -- First_Entity and Last_Entity.\n+\n+ Set_First_Entity (Spec_Id, Saved_First_Entity);\n+ Set_Last_Entity (Spec_Id, Saved_Last_Entity);\n+\n+ if Present (Last_Entity (Spec_Id)) then\n+ Set_Next_Entity (Last_Entity (Spec_Id), Empty);\n+ end if;\n+\n+ -- Freeze all types referenced in the expression\n+\n+ Freeze_References (Dup_Expr);\n+ end Freeze_Expr_Types;\n+\n+ -- Local variables\n+\n Asp : Node_Id;\n- Def_Id : Entity_Id;\n New_Body : Node_Id;\n New_Spec : Node_Id;\n Orig_N : Node_Id;\n Ret : Node_Id;\n- Ret_Type : Entity_Id;\n \n- Prev : Entity_Id;\n+ Def_Id : Entity_Id;\n+ Prev : Entity_Id;\n -- If the expression is a completion, Prev is the entity whose\n -- declaration is completed. Def_Id is needed to analyze the spec.\n \n+ -- Start of processing for Analyze_Expression_Function\n+\n begin\n -- This is one of the occasions on which we transform the tree during\n -- semantic analysis. If this is a completion, transform the expression\n@@ -319,7 +515,7 @@\n end if;\n end if;\n \n- Ret := Make_Simple_Return_Statement (LocX, Expression (N));\n+ Ret := Make_Simple_Return_Statement (LocX, Expr);\n \n New_Body :=\n Make_Subprogram_Body (Loc,\n@@ -361,48 +557,22 @@\n -- to be inlined.\n \n elsif Present (Prev)\n- and then Comes_From_Source (Parent (Prev))\n+ and then Is_Overloadable (Prev)\n and then not Is_Formal_Subprogram (Prev)\n+ and then Comes_From_Source (Parent (Prev))\n then\n Set_Has_Completion (Prev, False);\n Set_Is_Inlined (Prev);\n- Ret_Type := Etype (Prev);\n \n- -- An expression function which acts as a completion freezes the\n- -- expression. This means freezing the return type, and if it is\n- -- an access type, freezing its designated type as well.\n+ -- AI12-0103: Expression functions that are a completion freeze their\n+ -- expression but don't freeze anything else (unlike regular bodies).\n \n -- Note that we cannot defer this freezing to the analysis of the\n -- expression itself, because a freeze node might appear in a nested\n -- scope, leading to an elaboration order issue in gigi.\n \n- Freeze_Before (N, Ret_Type);\n+ Freeze_Expr_Types (Def_Id);\n \n- -- An entity can only be frozen if it is complete, so if the type\n- -- is still unfrozen it must still be incomplete in some way, e.g.\n- -- a private type without a full view, or a type derived from such\n- -- in an enclosing scope. Except in a generic context (where the\n- -- type may be a generic formal or derived from such), such use of\n- -- an incomplete type is an error. On the other hand, if this is a\n- -- limited view of a type, the type is declared in another unit and\n- -- frozen there. We must be in a context seeing the nonlimited view\n- -- of the type, which will be installed when the body is compiled.\n-\n- if not Is_Frozen (Ret_Type)\n- and then not Is_Generic_Type (Root_Type (Ret_Type))\n- and then not Inside_A_Generic\n- then\n- if From_Limited_With (Ret_Type)\n- and then Present (Non_Limited_View (Ret_Type))\n- then\n- null;\n- else\n- Error_Msg_NE\n- (\"premature use of private type&\",\n- Result_Definition (Specification (N)), Ret_Type);\n- end if;\n- end if;\n-\n -- For navigation purposes, indicate that the function is a body\n \n Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True);\n@@ -2273,11 +2443,6 @@\n -- limited views with the non-limited ones. Return the list of changes\n -- to be used to undo the transformation.\n \n- procedure Freeze_Expr_Types (Spec_Id : Entity_Id);\n- -- AI12-0103: N is the body associated with an expression function that\n- -- is a completion, and Spec_Id is its defining entity. Freeze before N\n- -- all the types referenced by the expression of the function.\n-\n function Is_Private_Concurrent_Primitive\n (Subp_Id : Entity_Id) return Boolean;\n -- Determine whether subprogram Subp_Id is a primitive of a concurrent\n@@ -3003,180 +3168,6 @@\n return Result;\n end Exchange_Limited_Views;\n \n- -----------------------\n- -- Freeze_Expr_Types --\n- -----------------------\n-\n- procedure Freeze_Expr_Types (Spec_Id : Entity_Id) is\n- function Cloned_Expression return Node_Id;\n- -- Build a duplicate of the expression of the return statement that\n- -- has no defining entities shared with the original expression.\n-\n- function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result;\n- -- Freeze all types referenced in the subtree rooted at Node\n-\n- -----------------------\n- -- Cloned_Expression --\n- -----------------------\n-\n- function Cloned_Expression return Node_Id is\n- function Clone_Id (Node : Node_Id) return Traverse_Result;\n- -- Tree traversal routine that clones the defining identifier of\n- -- iterator and loop parameter specification nodes.\n-\n- ----------------\n- -- Check_Node --\n- ----------------\n-\n- function Clone_Id (Node : Node_Id) return Traverse_Result is\n- begin\n- if Nkind_In (Node, N_Iterator_Specification,\n- N_Loop_Parameter_Specification)\n- then\n- Set_Defining_Identifier (Node,\n- New_Copy (Defining_Identifier (Node)));\n- end if;\n-\n- return OK;\n- end Clone_Id;\n-\n- -------------------\n- -- Clone_Def_Ids --\n- -------------------\n-\n- procedure Clone_Def_Ids is new Traverse_Proc (Clone_Id);\n-\n- -- Local variables\n-\n- Return_Stmt : constant Node_Id :=\n- First\n- (Statements (Handled_Statement_Sequence (N)));\n- Dup_Expr : Node_Id;\n-\n- -- Start of processing for Cloned_Expression\n-\n- begin\n- pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);\n-\n- -- We must duplicate the expression with semantic information to\n- -- inherit the decoration of global entities in generic instances.\n- -- Set the parent of the new node to be the parent of the original\n- -- to get the proper context, which is needed for complete error\n- -- reporting and for semantic analysis.\n-\n- Dup_Expr := New_Copy_Tree (Expression (Return_Stmt));\n- Set_Parent (Dup_Expr, Return_Stmt);\n-\n- -- Replace the defining identifier of iterators and loop param\n- -- specifications by a clone to ensure that the cloned expression\n- -- and the original expression don't have shared identifiers;\n- -- otherwise, as part of the preanalysis of the expression, these\n- -- shared identifiers may be left decorated with itypes which\n- -- will not be available in the tree passed to the backend.\n-\n- Clone_Def_Ids (Dup_Expr);\n-\n- return Dup_Expr;\n- end Cloned_Expression;\n-\n- ----------------------\n- -- Freeze_Type_Refs --\n- ----------------------\n-\n- function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result is\n- begin\n- if Nkind (Node) = N_Identifier\n- and then Present (Entity (Node))\n- then\n- if Is_Type (Entity (Node)) then\n- Freeze_Before (N, Entity (Node));\n-\n- elsif Ekind_In (Entity (Node), E_Component,\n- E_Discriminant)\n- then\n- declare\n- Rec : constant Entity_Id := Scope (Entity (Node));\n- begin\n-\n- -- Check that the enclosing record type can be frozen.\n- -- This provides a better error message than generating\n- -- primitives whose compilation fails much later. Refine\n- -- the error message if possible.\n-\n- Check_Fully_Declared (Rec, Node);\n-\n- if Error_Posted (Node) then\n- if Has_Private_Component (Rec) then\n- Error_Msg_NE\n- (\"\\type& has private component\", Node, Rec);\n- end if;\n-\n- else\n- Freeze_Before (N, Rec);\n- end if;\n- end;\n- end if;\n-\n- -- Freezing an access type does not freeze the designated type,\n- -- but freezing conversions between access to interfaces requires\n- -- that the interface types themselves be frozen, so that dispatch\n- -- table entities are properly created.\n-\n- -- Unclear whether a more general rule is needed ???\n-\n- elsif Nkind (Node) = N_Type_Conversion\n- and then Is_Access_Type (Etype (Node))\n- and then Is_Interface (Designated_Type (Etype (Node)))\n- then\n- Freeze_Before (N, Designated_Type (Etype (Node)));\n- end if;\n-\n- return OK;\n- end Freeze_Type_Refs;\n-\n- procedure Freeze_References is new Traverse_Proc (Freeze_Type_Refs);\n-\n- -- Local variables\n-\n- Saved_First_Entity : constant Entity_Id := First_Entity (Spec_Id);\n- Saved_Last_Entity : constant Entity_Id := Last_Entity (Spec_Id);\n- Dup_Expr : constant Node_Id := Cloned_Expression;\n-\n- -- Start of processing for Freeze_Expr_Types\n-\n- begin\n- -- Preanalyze a duplicate of the expression to have available the\n- -- minimum decoration needed to locate referenced unfrozen types\n- -- without adding any decoration to the function expression. This\n- -- preanalysis is performed with errors disabled to avoid reporting\n- -- spurious errors on Ghost entities (since the expression is not\n- -- fully analyzed).\n-\n- Push_Scope (Spec_Id);\n- Install_Formals (Spec_Id);\n- Ignore_Errors_Enable := Ignore_Errors_Enable + 1;\n-\n- Preanalyze_Spec_Expression (Dup_Expr, Etype (Spec_Id));\n-\n- Ignore_Errors_Enable := Ignore_Errors_Enable - 1;\n- End_Scope;\n-\n- -- Restore certain attributes of Spec_Id since the preanalysis may\n- -- have introduced itypes to this scope, thus modifying attributes\n- -- First_Entity and Last_Entity.\n-\n- Set_First_Entity (Spec_Id, Saved_First_Entity);\n- Set_Last_Entity (Spec_Id, Saved_Last_Entity);\n-\n- if Present (Last_Entity (Spec_Id)) then\n- Set_Next_Entity (Last_Entity (Spec_Id), Empty);\n- end if;\n-\n- -- Freeze all types referenced in the expression\n-\n- Freeze_References (Dup_Expr);\n- end Freeze_Expr_Types;\n-\n -------------------------------------\n -- Is_Private_Concurrent_Primitive --\n -------------------------------------\n@@ -3627,17 +3618,6 @@\n then\n Set_Has_Delayed_Freeze (Spec_Id);\n Freeze_Before (N, Spec_Id);\n-\n- -- AI12-0103: At the occurrence of an expression function\n- -- declaration that is a completion, its expression causes\n- -- freezing.\n-\n- if Has_Completion (Spec_Id)\n- and then Nkind (N) = N_Subprogram_Body\n- and then Was_Expression_Function (N)\n- then\n- Freeze_Expr_Types (Spec_Id);\n- end if;\n end if;\n end if;\n \n", "prefixes": [ "Ada" ] }