Patch Detail
get:
Show a patch.
patch:
Update a patch.
put:
Update a patch.
GET /api/1.2/patches/813295/?format=api
{ "id": 813295, "url": "http://patchwork.ozlabs.org/api/1.2/patches/813295/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/patch/20170913100331.GA80823@us.adacore.com/", "project": { "id": 17, "url": "http://patchwork.ozlabs.org/api/1.2/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": "<20170913100331.GA80823@us.adacore.com>", "list_archive_url": null, "date": "2017-09-13T10:03:31", "name": "[Ada] Undefined symbol at link time due to Disable_Controlled", "commit_ref": null, "pull_url": null, "state": "new", "archived": false, "hash": "3e875a518f5393f3d10209dbc873fcb4b86f5324", "submitter": { "id": 64226, "url": "http://patchwork.ozlabs.org/api/1.2/people/64226/?format=api", "name": "Pierre-Marie de Rodat", "email": "derodat@adacore.com" }, "delegate": null, "mbox": "http://patchwork.ozlabs.org/project/gcc/patch/20170913100331.GA80823@us.adacore.com/mbox/", "series": [ { "id": 2862, "url": "http://patchwork.ozlabs.org/api/1.2/series/2862/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/list/?series=2862", "date": "2017-09-13T10:03:31", "name": "[Ada] Undefined symbol at link time due to Disable_Controlled", "version": 1, "mbox": "http://patchwork.ozlabs.org/series/2862/mbox/" } ], "comments": "http://patchwork.ozlabs.org/api/patches/813295/comments/", "check": "pending", "checks": "http://patchwork.ozlabs.org/api/patches/813295/checks/", "tags": {}, "related": [], "headers": { "Return-Path": "<gcc-patches-return-462013-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-462013-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=\"COTxTmYS\"; 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 3xscgs4rBQz9s9Y\n\tfor <incoming@patchwork.ozlabs.org>;\n\tWed, 13 Sep 2017 20:03:53 +1000 (AEST)", "(qmail 71422 invoked by alias); 13 Sep 2017 10:03:40 -0000", "(qmail 70451 invoked by uid 89); 13 Sep 2017 10:03:38 -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\tWed, 13 Sep 2017 10:03:33 +0000", "from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id CAF585624E;\n\tWed, 13 Sep 2017 06:03:31 -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\ta1qgS+mNM5DR; Wed, 13 Sep 2017 06:03:31 -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 AB5B85624C;\n\tWed, 13 Sep 2017 06:03:31 -0400 (EDT)", "by tron.gnat.com (Postfix, from userid 4862)\tid A71D4521;\n\tWed, 13 Sep 2017 06:03:31 -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=CUCROylVsESshcEdrKvaEQNZNySDKs0/rDrSp6voLhr7mJ+po7\n\tcsG00RWheE/bI9pr/zL9c0UsNzWmuvM2KzCxx/qfgf7rUnXxCLm9xAWWfjgaA+8I\n\tbcI5pFIpVQdiTuk3naO0UYYZkjK4ogvuPj2gmCxebf9bUOaWAI3kjyLRg=", "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=ZQRrji3VWc7jhKjqNzI/iplBedQ=; b=COTxTmYS9rP7ylWnkB2k\n\tK4vWFABrUkZufDAAY67+5R4edN50D83/D25SEkRKOnMD6uSLG8rDdQMN/IxIzg4k\n\tOi4vbFaQx2y8wIO4HxVfnEuqeUBiM+8et0yJGYGG65evdUdFxz0C1d5IDq6wf5g7\n\tJlCROrLYPFzDXOG2xXyM96E=", "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=ini, ctrl", "X-HELO": "rock.gnat.com", "Date": "Wed, 13 Sep 2017 06:03:31 -0400", "From": "Pierre-Marie de Rodat <derodat@adacore.com>", "To": "gcc-patches@gcc.gnu.org", "Cc": "kirtchev@adacore.com, Arnaud Charlet <charlet@adacore.com>", "Subject": "[Ada] Undefined symbol at link time due to Disable_Controlled", "Message-ID": "<20170913100331.GA80823@us.adacore.com>", "MIME-Version": "1.0", "Content-Type": "multipart/mixed; boundary=\"UlVJffcvxoiEqYs2\"", "Content-Disposition": "inline", "User-Agent": "Mutt/1.5.23 (2014-03-12)", "X-IsSubscribed": "yes" }, "content": "This patch reimplements aspect Disable_Controlled to plug the following holes\nin its original implementation:\n\n * The aspect may appear without an expression in which case the aspect\n defaults to True, however the compiler would crash due to the lack of\n expression.\n\n * If the expression is present, then it should be static, however the\n compiler would silently accept a non-static expression.\n\n * Various types that derive and/or contain a component of a type subject\n to the aspect are now properly handled.\n\nThe patch also modifies predicate Is_Controlled to indicate whether a type is\nderived from [Limited_]Controlled AND NOT subject to aspect Disable_Controlled.\nThis modification allows the semantics of the aspect to automatically perculate\nto derived types and/or composite types with components subject to the aspect.\nAs a result, the finalization mechanism now properly handles such types and\ngenerates the appropriate Deep_Adjust, Deep_Initialize, and Deep_Finalize\nprimitives.\n\n------------\n-- Source --\n------------\n\n-- factorial.ads\n\nfunction Factorial (Val : Natural) return Natural;\n\n-- factorial.adb\n\nfunction Factorial (Val : Natural) return Natural is\nbegin\n if Val > 1 then\n return Val * Factorial (Val - 1);\n end if;\n\n return 1;\nend Factorial;\n\n-- semantics.ads\n\nwith Ada.Finalization; use Ada.Finalization;\nwith Factorial;\n\npackage Semantics is\n generic\n Flag : Boolean;\n Int : Integer;\n\n package Nested_Gen is\n type Ctrl_Rec_1 is new Controlled with null record\n with Disable_Controlled => Int; -- Error\n\n type Ctrl_Rec_2 is new Limited_Controlled with null record\n with Disable_Controlled => Factorial (3) = 6; -- N/A\n\n type Ctrl_Rec_3 is new Controlled with null record\n with Disable_Controlled => Flag; -- OK\n end Nested_Gen;\n\n subtype Small_Int is Integer range 1 .. 10\n with Disable_Controlled; -- Error\n\n type Rec is null record\n with Disable_Controlled => False; -- Error\n\n type Ctrl_Rec_1 is new Controlled with null record\n with Disable_Controlled => \"what?\"; -- Error\n\n type Ctrl_Rec_2 is new Limited_Controlled with null record\n with Disable_Controlled => Factorial (3) = 6; -- Error\n\n type Ctrl_Rec_3 is new Controlled with null record\n with Disable_Controlled => True; -- OK\n\n Is_True : constant Boolean := True;\n\n type Ctrl_Rec_4 is new Limited_Controlled with null record\n with Disable_Controlled => Is_True; -- OK\nend Semantics;\n\n-- types.ads\n\nwith Ada.Finalization; use Ada.Finalization;\n\npackage Types is\n generic\n Flag : Boolean;\n\n package Gen is\n type Ctrl is new Controlled with record\n Id : Natural;\n end record;\n\n procedure Adjust (Obj : in out Ctrl);\n procedure Finalize (Obj : in out Ctrl);\n procedure Initialize (Obj : in out Ctrl);\n\n type Ctrl_DC is new Controlled with record\n Id : Natural;\n end record\n with Disable_Controlled => Flag;\n\n procedure Adjust (Obj : in out Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_DC);\n\n type Ctrl_Ctrl_DC is new Controlled with record\n Id : Natural;\n Comp : Ctrl_DC;\n end record;\n\n procedure Adjust (Obj : in out Ctrl_Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_Ctrl_DC);\n\n type Ctrl_DC_Ctrl is new Controlled with record\n Id : Natural;\n Comp : Ctrl;\n end record\n with Disable_Controlled => True;\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl);\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl);\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl);\n\n type Ctrl_DC_Ctrl_DC is new Controlled with record\n Id : Natural;\n Comp : Ctrl_DC;\n end record\n with Disable_Controlled;\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl_DC);\n\n type Rec_Ctrl_DC is record\n Comp : Ctrl_DC;\n end record;\n end Gen;\n\n generic\n Typ_Name : String;\n type Typ is private;\n procedure Test;\n\n type Ctrl is new Controlled with record\n Id : Natural;\n end record;\n\n procedure Adjust (Obj : in out Ctrl);\n procedure Finalize (Obj : in out Ctrl);\n procedure Initialize (Obj : in out Ctrl);\n\n type Ctrl_DC is new Controlled with record\n Id : Natural;\n end record\n with Disable_Controlled => True;\n\n procedure Adjust (Obj : in out Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_DC);\n\n type Ctrl_Ctrl_DC is new Controlled with record\n Id : Natural;\n Comp : Ctrl_DC;\n end record;\n\n procedure Adjust (Obj : in out Ctrl_Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_Ctrl_DC);\n\n type Ctrl_DC_Ctrl is new Controlled with record\n Id : Natural;\n Comp : Ctrl;\n end record\n with Disable_Controlled => True;\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl);\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl);\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl);\n\n type Ctrl_DC_Ctrl_DC is new Controlled with record\n Id : Natural;\n Comp : Ctrl_DC;\n end record\n with Disable_Controlled;\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl_DC);\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl_DC);\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl_DC);\n\n type Rec_Ctrl_DC is record\n Comp : Ctrl_DC;\n end record;\nend Types;\n\n-- types.adb\n\nwith Ada.Text_IO; use Ada.Text_IO;\n\npackage body Types is\n Id_Gen : Natural := 100;\n\n procedure Adjust_Id (Owner : String; Id : in out Natural);\n procedure Finalize_Id (Owner : String; Id : in out Natural);\n procedure Initialize_Id (Owner : String; Id : in out Natural);\n\n --------\n -- Id --\n --------\n\n procedure Adjust_Id (Owner : String; Id : in out Natural) is\n Old_Id : constant Natural := Id;\n New_Id : constant Natural := Old_Id + 1;\n\n begin\n if Old_Id = 0 then\n Put_Line (\" \" & Owner & \" adj: ERROR: already finalized\");\n else\n Put_Line (\" \" & Owner & \" adj:\" & Old_Id'Img & \" =>\" & New_Id'Img);\n Id := New_Id;\n end if;\n end Adjust_Id;\n\n procedure Finalize_Id (Owner : String; Id : in out Natural) is\n Old_Id : constant Natural := Id;\n\n begin\n if Old_Id = 0 then\n Put_Line (\" \" & Owner & \" fin: ERROR: already finalized\");\n else\n Put_Line (\" \" & Owner & \" fin:\" & Old_Id'Img);\n Id := 0;\n end if;\n end Finalize_Id;\n\n procedure Initialize_Id (Owner : String; Id : in out Natural) is\n begin\n Id := Id_Gen;\n Id_Gen := Id_Gen + 1;\n Put_Line (\" \" & Owner & \" ini:\" & Id'Img);\n end Initialize_Id;\n\n package body Gen is\n\n ----------\n -- Ctrl --\n ----------\n\n procedure Adjust (Obj : in out Ctrl) is\n begin\n Adjust_Id (\"gen Ctrl\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl) is\n begin\n Finalize_Id (\"gen Ctrl\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl) is\n begin\n Initialize_Id (\"gen Ctrl\", Obj.Id);\n end Initialize;\n\n -------------\n -- Ctrl_DC --\n -------------\n\n procedure Adjust (Obj : in out Ctrl_DC) is\n begin\n Adjust_Id (\"gen Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC) is\n begin\n Finalize_Id (\"gen Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC) is\n begin\n Initialize_Id (\"gen Ctrl_DC\", Obj.Id);\n end Initialize;\n\n ------------------\n -- Ctrl_Ctrl_DC --\n ------------------\n\n procedure Adjust (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Adjust_Id (\"gen Ctrl_Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Finalize_Id (\"gen Ctrl_Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Initialize_Id (\"gen Ctrl_Ctrl_DC\", Obj.Id);\n end Initialize;\n\n -------------\n -- Ctrl_DC --\n -------------\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Adjust_Id (\"gen Ctrl_DC_Ctrl\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Finalize_Id (\"gen Ctrl_DC_Ctrl\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Initialize_Id (\"gen Ctrl_DC_Ctrl\", Obj.Id);\n end Initialize;\n\n ---------------------\n -- Ctrl_DC_Ctrl_DC --\n ---------------------\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Adjust_Id (\"gen Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Finalize_Id (\"gen Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Initialize_Id (\"gen Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Initialize;\n end Gen;\n\n procedure Test is\n begin\n Put_Line (Typ_Name & \" start\");\n declare\n Obj_1 : Typ;\n Obj_2 : Typ;\n pragma Warnings (Off, Obj_2);\n begin\n Obj_1 := Obj_2;\n end;\n Put_Line (Typ_Name & \" end\");\n end Test;\n\n ----------\n -- Ctrl --\n ----------\n\n procedure Adjust (Obj : in out Ctrl) is\n begin\n Adjust_Id (\"Ctrl\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl) is\n begin\n Finalize_Id (\"Ctrl\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl) is\n begin\n Initialize_Id (\"Ctrl\", Obj.Id);\n end Initialize;\n\n -------------\n -- Ctrl_DC --\n -------------\n\n procedure Adjust (Obj : in out Ctrl_DC) is\n begin\n Adjust_Id (\"Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC) is\n begin\n Finalize_Id (\"Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC) is\n begin\n Initialize_Id (\"Ctrl_DC\", Obj.Id);\n end Initialize;\n\n ------------------\n -- Ctrl_Ctrl_DC --\n ------------------\n\n procedure Adjust (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Adjust_Id (\"Ctrl_Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Finalize_Id (\"Ctrl_Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_Ctrl_DC) is\n begin\n Initialize_Id (\"Ctrl_Ctrl_DC\", Obj.Id);\n end Initialize;\n\n -------------\n -- Ctrl_DC --\n -------------\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Adjust_Id (\"Ctrl_DC_Ctrl\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Finalize_Id (\"Ctrl_DC_Ctrl\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl) is\n begin\n Initialize_Id (\"Ctrl_DC_Ctrl\", Obj.Id);\n end Initialize;\n\n ---------------------\n -- Ctrl_DC_Ctrl_DC --\n ---------------------\n\n procedure Adjust (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Adjust_Id (\"Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Adjust;\n\n procedure Finalize (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Finalize_Id (\"Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Finalize;\n\n procedure Initialize (Obj : in out Ctrl_DC_Ctrl_DC) is\n begin\n Initialize_Id (\"Ctrl_DC_Ctrl_DC\", Obj.Id);\n end Initialize;\nend Types;\n\n----------------------------\n-- Compilation and output --\n----------------------------\n\n$ gcc -c semantics.ads\n$ gnatmake -q executable.adb\n$ ./executable\nsemantics.ads:11:36: expected a boolean type\nsemantics.ads:11:36: found type \"Standard.Integer\"\nsemantics.ads:21:11: aspect \"Disable_Controlled\" requires controlled record\n type\nsemantics.ads:24:11: aspect \"Disable_Controlled\" requires controlled record\n type\nsemantics.ads:27:33: expected a boolean type\nsemantics.ads:27:33: found a string type\nsemantics.ads:30:11: expression of aspect \"Disable_Controlled\" must be static\ngen Ctrl start\n gen Ctrl ini: 100\n gen Ctrl ini: 101\n gen Ctrl fin: 100\n gen Ctrl adj: 101 => 102\n gen Ctrl fin: 101\n gen Ctrl fin: 102\ngen Ctrl end\ngen Ctrl_DC start\ngen Ctrl_DC end\ngen Ctrl_Ctrl_DC start\n gen Ctrl_Ctrl_DC ini: 102\n gen Ctrl_Ctrl_DC ini: 103\n gen Ctrl_Ctrl_DC fin: 102\n gen Ctrl_Ctrl_DC adj: 103 => 104\n gen Ctrl_Ctrl_DC fin: 103\n gen Ctrl_Ctrl_DC fin: 104\ngen Ctrl_Ctrl_DC end\ngen Ctrl_DC_Ctrl start\n gen Ctrl ini: 104\n gen Ctrl ini: 105\n gen Ctrl fin: 104\n gen Ctrl adj: 105 => 106\n gen Ctrl fin: 105\n gen Ctrl fin: 106\ngen Ctrl_DC_Ctrl end\ngen Ctrl_DC_Ctrl_DC start\ngen Ctrl_DC_Ctrl_DC end\ngen Rec_Ctrl_DC start\ngen Rec_Ctrl_DC end\nCtrl start\n Ctrl ini: 106\n Ctrl ini: 107\n Ctrl fin: 106\n Ctrl adj: 107 => 108\n Ctrl fin: 107\n Ctrl fin: 108\nCtrl end\nCtrl_DC start\nCtrl_DC end\nCtrl_Ctrl_DC start\n Ctrl_Ctrl_DC ini: 108\n Ctrl_Ctrl_DC ini: 109\n Ctrl_Ctrl_DC fin: 108\n Ctrl_Ctrl_DC adj: 109 => 110\n Ctrl_Ctrl_DC fin: 109\n Ctrl_Ctrl_DC fin: 110\nCtrl_Ctrl_DC end\nCtrl_DC_Ctrl start\n Ctrl ini: 110\n Ctrl ini: 111\n Ctrl fin: 110\n Ctrl adj: 111 => 112\n Ctrl fin: 111\n Ctrl fin: 112\nCtrl_DC_Ctrl end\nCtrl_DC_Ctrl_DC start\nCtrl_DC_Ctrl_DC end\nRec_Ctrl_DC start\nRec_Ctrl_DC end\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-13 Hristian Kirtchev <kirtchev@adacore.com>\n\n\t* einfo.adb: Flag42 is now Is_Controlled_Active.\n\t(Is_Controlled): This attribute is now synthesized.\n\t(Is_Controlled_Active): This attribute is now an explicit flag rather\n\tthan a synthesized attribute.\t(Set_Is_Controlled): Removed.\n\t(Set_Is_Controlled_Active): New routine.\n\t(Write_Entity_Flags): Update the output for Flag42.\n\t* einfo.ads: Update the documentation of the following attributes:\n\tDisable_Controlled, Is_Controlled, Is_Controlled_Active, Is_Controlled\n\tand Is_Controlled_Active have swapped their functionality.\n\t(Is_Controlled): Renamed to Is_Controlled_Active.\n\t(Is_Controlled_Active): Renamed to Is_Controlled.\n\t(Set_Is_Controlled): Renamed to Set_Is_Controlled_Active.\n\t* exp_ch3.adb (Expand_Freeze_Record_Type): Restore the original use of\n\tIs_Controlled.\n\t* exp_util.adb (Has_Some_Controlled_Component): Code clean up.\n\t(Needs_Finalization): Code clean up. Remove the tests for\n\tDisable_Controlled because a) they were incorrect as they would reject\n\ta type which is sublect to the aspect, but may contain controlled\n\tcomponents, and b) they are no longer necessary.\n\t* exp_util.ads (Needs_Finalization): Update comment on documentation.\n\t* freeze.adb (Freeze_Array_Type): Restore the original use of\n\tIs_Controlled.\n\t(Freeze_Record_Type): Restore the original use of Is_Controlled.\n\t* sem_ch3.adb (Analyze_Object_Declaration): Restore the original use of\n\tIs_Controlled.\n\t(Array_Type_Declaration): Restore the original use of Is_Controlled.\n\t(Build_Derived_Private_Type): Restore the original use of\n\tIs_Controlled.\n\t(Build_Derived_Record_Type): Set the Is_Controlled_Active flag of a\n\ttype derived from Ada.Finalization.[Limited_]Controlled.\n\t(Build_Derived_Type): Restore the original use of Is_Controlled.\n\t(Record_Type_Definition): Restore the original use of Is_Controlled.\n\t* sem_ch7.adb (Preserve_Full_Attributes): Restore the original use of\n\tIs_Controlled.\n\t* sem_ch13.adb (Analyze_Aspect_Disable_Controlled): New routine.\n\t(Analyze_Aspect_Specifications): Use routine\n\tAnalyze_Aspect_Disable_Controlled to process aspect Disable_Controlled.", "diff": "Index: einfo.adb\n===================================================================\n--- einfo.adb\t(revision 252062)\n+++ einfo.adb\t(working copy)\n@@ -334,7 +334,7 @@\n -- Body_Needed_For_SAL Flag40\n \n -- Treat_As_Volatile Flag41\n- -- Is_Controlled Flag42\n+ -- Is_Controlled_Active Flag42\n -- Has_Controlled_Component Flag43\n -- Is_Pure Flag44\n -- In_Private_Part Flag45\n@@ -2189,10 +2189,10 @@\n return Flag76 (Id);\n end Is_Constructor;\n \n- function Is_Controlled (Id : E) return B is\n+ function Is_Controlled_Active (Id : E) return B is\n begin\n return Flag42 (Base_Type (Id));\n- end Is_Controlled;\n+ end Is_Controlled_Active;\n \n function Is_Controlling_Formal (Id : E) return B is\n begin\n@@ -5341,11 +5341,11 @@\n Set_Flag76 (Id, V);\n end Set_Is_Constructor;\n \n- procedure Set_Is_Controlled (Id : E; V : B := True) is\n+ procedure Set_Is_Controlled_Active (Id : E; V : B := True) is\n begin\n pragma Assert (Id = Base_Type (Id));\n Set_Flag42 (Id, V);\n- end Set_Is_Controlled;\n+ end Set_Is_Controlled_Active;\n \n procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is\n begin\n@@ -7902,14 +7902,14 @@\n K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;\n end Is_Constant_Object;\n \n- --------------------------\n- -- Is_Controlled_Active --\n- --------------------------\n+ -------------------\n+ -- Is_Controlled --\n+ -------------------\n \n- function Is_Controlled_Active (Id : E) return B is\n+ function Is_Controlled (Id : E) return B is\n begin\n- return Is_Controlled (Id) and then not Disable_Controlled (Id);\n- end Is_Controlled_Active;\n+ return Is_Controlled_Active (Id) and then not Disable_Controlled (Id);\n+ end Is_Controlled;\n \n --------------------\n -- Is_Discriminal --\n@@ -9549,7 +9549,7 @@\n W (\"Is_Constr_Subt_For_U_Nominal\", Flag80 (Id));\n W (\"Is_Constrained\", Flag12 (Id));\n W (\"Is_Constructor\", Flag76 (Id));\n- W (\"Is_Controlled\", Flag42 (Id));\n+ W (\"Is_Controlled_Active\", Flag42 (Id));\n W (\"Is_Controlling_Formal\", Flag97 (Id));\n W (\"Is_Descendant_Of_Address\", Flag223 (Id));\n W (\"Is_DIC_Procedure\", Flag132 (Id));\nIndex: einfo.ads\n===================================================================\n--- einfo.ads\t(revision 252062)\n+++ einfo.ads\t(working copy)\n@@ -980,8 +980,9 @@\n -- incomplete type.\n \n -- Disable_Controlled (Flag253)\n--- Present in all entities. Set for a controlled type (Is_Controlled flag\n--- set) if the aspect Disable_Controlled is active for the type.\n+-- Present in all entities. Set for a controlled type subject to aspect\n+-- Disable_Controlled which evaluates to True. This flag is taken into\n+-- account in synthesized attribute Is_Controlled.\n \n -- Discard_Names (Flag88)\n -- Defined in types and exception entities. Set if pragma Discard_Names\n@@ -2443,14 +2444,14 @@\n -- Defined in function and procedure entities. Set if a pragma\n -- CPP_Constructor applies to the subprogram.\n \n--- Is_Controlled (Flag42) [base type only]\n+-- Is_Controlled_Active (Flag42) [base type only]\n -- Defined in all type entities. Indicates that the type is controlled,\n -- i.e. is either a descendant of Ada.Finalization.Controlled or of\n -- Ada.Finalization.Limited_Controlled.\n \n--- Is_Controlled_Active (synth) [base type only]\n--- Defined in all type entities. Set if Is_Controlled is set for the\n--- type, and Disable_Controlled is not set.\n+-- Is_Controlled (synth) [base type only]\n+-- Defined in all type entities. Set if Is_Controlled_Active is set for\n+-- the type, and Disable_Controlled is not set.\n \n -- Is_Controlling_Formal (Flag97)\n -- Defined in all Formal_Kind entities. Marks the controlling parameters\n@@ -5648,7 +5649,7 @@\n -- Is_Atomic (Flag85)\n -- Is_Constr_Subt_For_U_Nominal (Flag80)\n -- Is_Constr_Subt_For_UN_Aliased (Flag141)\n- -- Is_Controlled (Flag42) (base type only)\n+ -- Is_Controlled_Active (Flag42) (base type only)\n -- Is_Eliminated (Flag124)\n -- Is_Frozen (Flag4)\n -- Is_Generic_Actual_Type (Flag94)\n@@ -5684,7 +5685,7 @@\n -- Invariant_Procedure (synth)\n -- Is_Access_Protected_Subprogram_Type (synth)\n -- Is_Atomic_Or_VFA (synth)\n- -- Is_Controlled_Active (synth)\n+ -- Is_Controlled (synth)\n -- Partial_Invariant_Procedure (synth)\n -- Predicate_Function (synth)\n -- Predicate_Function_M (synth)\n@@ -6344,7 +6345,7 @@\n -- Private_View (Node22)\n -- Stored_Constraint (Elist23)\n -- Has_Completion (Flag26)\n- -- Is_Controlled (Flag42) (base type only)\n+ -- Is_Controlled_Active (Flag42) (base type only)\n -- Is_For_Access_Subtype (Flag118) (subtype only)\n -- (plus type attributes)\n \n@@ -6497,7 +6498,7 @@\n -- Is_Class_Wide_Equivalent_Type (Flag35)\n -- Is_Concurrent_Record_Type (Flag20)\n -- Is_Constrained (Flag12)\n- -- Is_Controlled (Flag42) (base type only)\n+ -- Is_Controlled_Active (Flag42) (base type only)\n -- Is_Interface (Flag186)\n -- Is_Limited_Interface (Flag197)\n -- No_Reordering (Flag239) (base type only)\n@@ -6526,7 +6527,7 @@\n -- Has_Record_Rep_Clause (Flag65) (base type only)\n -- Is_Concurrent_Record_Type (Flag20)\n -- Is_Constrained (Flag12)\n- -- Is_Controlled (Flag42) (base type only)\n+ -- Is_Controlled_Active (Flag42) (base type only)\n -- Is_Interface (Flag186)\n -- Is_Limited_Interface (Flag197)\n -- No_Reordering (Flag239) (base type only)\n@@ -7169,7 +7170,7 @@\n function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;\n function Is_Constrained (Id : E) return B;\n function Is_Constructor (Id : E) return B;\n- function Is_Controlled (Id : E) return B;\n+ function Is_Controlled_Active (Id : E) return B;\n function Is_Controlling_Formal (Id : E) return B;\n function Is_CPP_Class (Id : E) return B;\n function Is_Descendant_Of_Address (Id : E) return B;\n@@ -7489,7 +7490,7 @@\n function Is_Base_Type (Id : E) return B;\n function Is_Boolean_Type (Id : E) return B;\n function Is_Constant_Object (Id : E) return B;\n- function Is_Controlled_Active (Id : E) return B;\n+ function Is_Controlled (Id : E) return B;\n function Is_Discriminal (Id : E) return B;\n function Is_Dynamic_Scope (Id : E) return B;\n function Is_External_State (Id : E) return B;\n@@ -7858,7 +7859,7 @@\n procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);\n procedure Set_Is_Constrained (Id : E; V : B := True);\n procedure Set_Is_Constructor (Id : E; V : B := True);\n- procedure Set_Is_Controlled (Id : E; V : B := True);\n+ procedure Set_Is_Controlled_Active (Id : E; V : B := True);\n procedure Set_Is_Controlling_Formal (Id : E; V : B := True);\n procedure Set_Is_CPP_Class (Id : E; V : B := True);\n procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True);\n@@ -8676,7 +8677,7 @@\n pragma Inline (Is_Constr_Subt_For_UN_Aliased);\n pragma Inline (Is_Constrained);\n pragma Inline (Is_Constructor);\n- pragma Inline (Is_Controlled);\n+ pragma Inline (Is_Controlled_Active);\n pragma Inline (Is_Controlling_Formal);\n pragma Inline (Is_CPP_Class);\n pragma Inline (Is_Decimal_Fixed_Point_Type);\n@@ -9190,7 +9191,7 @@\n pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);\n pragma Inline (Set_Is_Constrained);\n pragma Inline (Set_Is_Constructor);\n- pragma Inline (Set_Is_Controlled);\n+ pragma Inline (Set_Is_Controlled_Active);\n pragma Inline (Set_Is_Controlling_Formal);\n pragma Inline (Set_Is_CPP_Class);\n pragma Inline (Set_Is_Descendant_Of_Address);\n@@ -9434,7 +9435,7 @@\n \n pragma Inline (Base_Type);\n pragma Inline (Is_Base_Type);\n- pragma Inline (Is_Controlled_Active);\n+ pragma Inline (Is_Controlled);\n pragma Inline (Is_Package_Or_Generic_Package);\n pragma Inline (Is_Packed_Array);\n pragma Inline (Is_Subprogram_Or_Generic_Subprogram);\nIndex: exp_ch3.adb\n===================================================================\n--- exp_ch3.adb\t(revision 252062)\n+++ exp_ch3.adb\t(working copy)\n@@ -4951,7 +4951,7 @@\n and then\n (Has_Controlled_Component (Comp_Typ)\n or else (Chars (Comp) /= Name_uParent\n- and then (Is_Controlled_Active (Comp_Typ))))\n+ and then Is_Controlled (Comp_Typ)))\n then\n Set_Has_Controlled_Component (Typ);\n end if;\nIndex: exp_util.adb\n===================================================================\n--- exp_util.adb\t(revision 252062)\n+++ exp_util.adb\t(working copy)\n@@ -10296,48 +10296,48 @@\n -- Needs_Finalization --\n ------------------------\n \n- function Needs_Finalization (T : Entity_Id) return Boolean is\n- function Has_Some_Controlled_Component (Rec : Entity_Id) return Boolean;\n- -- If type is not frozen yet, check explicitly among its components,\n- -- because the Has_Controlled_Component flag is not necessarily set.\n+ function Needs_Finalization (Typ : Entity_Id) return Boolean is\n+ function Has_Some_Controlled_Component\n+ (Input_Typ : Entity_Id) return Boolean;\n+ -- Determine whether type Input_Typ has at least one controlled\n+ -- component.\n \n -----------------------------------\n -- Has_Some_Controlled_Component --\n -----------------------------------\n \n function Has_Some_Controlled_Component\n- (Rec : Entity_Id) return Boolean\n+ (Input_Typ : Entity_Id) return Boolean\n is\n Comp : Entity_Id;\n \n begin\n- if Has_Controlled_Component (Rec) then\n+ -- When a type is already frozen and has at least one controlled\n+ -- component, or is manually decorated, it is sufficient to inspect\n+ -- flag Has_Controlled_Component.\n+\n+ if Has_Controlled_Component (Input_Typ) then\n return True;\n \n- elsif not Is_Frozen (Rec) then\n- if Is_Record_Type (Rec) then\n- Comp := First_Entity (Rec);\n+ -- Otherwise inspect the internals of the type\n \n+ elsif not Is_Frozen (Input_Typ) then\n+ if Is_Array_Type (Input_Typ) then\n+ return Needs_Finalization (Component_Type (Input_Typ));\n+\n+ elsif Is_Record_Type (Input_Typ) then\n+ Comp := First_Component (Input_Typ);\n while Present (Comp) loop\n- if not Is_Type (Comp)\n- and then Needs_Finalization (Etype (Comp))\n- then\n+ if Needs_Finalization (Etype (Comp)) then\n return True;\n end if;\n \n- Next_Entity (Comp);\n+ Next_Component (Comp);\n end loop;\n-\n- return False;\n-\n- else\n- return\n- Is_Array_Type (Rec)\n- and then Needs_Finalization (Component_Type (Rec));\n end if;\n- else\n- return False;\n end if;\n+\n+ return False;\n end Has_Some_Controlled_Component;\n \n -- Start of processing for Needs_Finalization\n@@ -10349,32 +10349,34 @@\n if Restriction_Active (No_Finalization) then\n return False;\n \n- -- C++ types are not considered controlled. It is assumed that the\n- -- non-Ada side will handle their clean up.\n+ -- C++ types are not considered controlled. It is assumed that the non-\n+ -- Ada side will handle their clean up.\n \n- elsif Convention (T) = Convention_CPP then\n+ elsif Convention (Typ) = Convention_CPP then\n return False;\n \n- -- Never needs finalization if Disable_Controlled set\n+ -- Class-wide types are treated as controlled because derivations from\n+ -- the root type may introduce controlled components.\n \n- elsif Disable_Controlled (T) then\n- return False;\n+ elsif Is_Class_Wide_Type (Typ) then\n+ return True;\n \n- elsif Is_Class_Wide_Type (T) and then Disable_Controlled (Etype (T)) then\n- return False;\n+ -- Concurrent types are controlled as long as their corresponding record\n+ -- is controlled.\n \n+ elsif Is_Concurrent_Type (Typ)\n+ and then Present (Corresponding_Record_Type (Typ))\n+ and then Needs_Finalization (Corresponding_Record_Type (Typ))\n+ then\n+ return True;\n+\n+ -- Otherwise the type is controlled when it is either derived from type\n+ -- [Limited_]Controlled and not subject to aspect Disable_Controlled, or\n+ -- contains at least one controlled component.\n+\n else\n- -- Class-wide types are treated as controlled because derivations\n- -- from the root type can introduce controlled components.\n-\n return\n- Is_Class_Wide_Type (T)\n- or else Is_Controlled (T)\n- or else Has_Some_Controlled_Component (T)\n- or else\n- (Is_Concurrent_Type (T)\n- and then Present (Corresponding_Record_Type (T))\n- and then Needs_Finalization (Corresponding_Record_Type (T)));\n+ Is_Controlled (Typ) or else Has_Some_Controlled_Component (Typ);\n end if;\n end Needs_Finalization;\n \n@@ -10387,7 +10389,6 @@\n Typ : Entity_Id) return Boolean\n is\n begin\n-\n -- If we have no initialization of any kind, then we don't need to place\n -- any restrictions on the address clause, because the object will be\n -- elaborated after the address clause is evaluated. This happens if the\nIndex: exp_util.ads\n===================================================================\n--- exp_util.ads\t(revision 252062)\n+++ exp_util.ads\t(working copy)\n@@ -924,11 +924,9 @@\n -- consist of constants, when the object has a nontrivial initialization\n -- or is controlled.\n \n- function Needs_Finalization (T : Entity_Id) return Boolean;\n- -- True if type T is controlled, or has controlled subcomponents. Also\n- -- True if T is a class-wide type, because some type extension might add\n- -- controlled subcomponents, except that if pragma Restrictions\n- -- (No_Finalization) applies, this is False for class-wide types.\n+ function Needs_Finalization (Typ : Entity_Id) return Boolean;\n+ -- Determine whether type Typ is controlled and this requires finalization\n+ -- actions.\n \n function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;\n -- An anonymous access type may designate a limited view. Check whether\nIndex: freeze.adb\n===================================================================\n--- freeze.adb\t(revision 252062)\n+++ freeze.adb\t(working copy)\n@@ -2574,7 +2574,7 @@\n \n -- Propagate flags for component type\n \n- if Is_Controlled_Active (Component_Type (Arr))\n+ if Is_Controlled (Component_Type (Arr))\n or else Has_Controlled_Component (Ctyp)\n then\n Set_Has_Controlled_Component (Arr);\n@@ -4508,7 +4508,7 @@\n (Has_Controlled_Component (Etype (Comp))\n or else\n (Chars (Comp) /= Name_uParent\n- and then Is_Controlled_Active (Etype (Comp)))\n+ and then Is_Controlled (Etype (Comp)))\n or else\n (Is_Protected_Type (Etype (Comp))\n and then\nIndex: sem_ch13.adb\n===================================================================\n--- sem_ch13.adb\t(revision 252062)\n+++ sem_ch13.adb\t(working copy)\n@@ -1595,6 +1595,9 @@\n procedure Analyze_Aspect_Convention;\n -- Perform analysis of aspect Convention\n \n+ procedure Analyze_Aspect_Disable_Controlled;\n+ -- Perform analysis of aspect Disable_Controlled\n+\n procedure Analyze_Aspect_Export_Import;\n -- Perform analysis of aspects Export or Import\n \n@@ -1678,6 +1681,60 @@\n end if;\n end Analyze_Aspect_Convention;\n \n+ ---------------------------------------\n+ -- Analyze_Aspect_Disable_Controlled --\n+ ---------------------------------------\n+\n+ procedure Analyze_Aspect_Disable_Controlled is\n+ begin\n+ -- The aspect applies only to controlled records\n+\n+ if not (Ekind (E) = E_Record_Type\n+ and then Is_Controlled_Active (E))\n+ then\n+ Error_Msg_N\n+ (\"aspect % requires controlled record type\", Aspect);\n+ return;\n+ end if;\n+\n+ -- Preanalyze the expression (if any) when the aspect resides\n+ -- in a generic unit.\n+\n+ if Inside_A_Generic then\n+ if Present (Expr) then\n+ Preanalyze_And_Resolve (Expr, Any_Boolean);\n+ end if;\n+\n+ -- Otherwise the aspect resides in a nongeneric context\n+\n+ else\n+ -- A controlled record type loses its controlled semantics\n+ -- when the expression statically evaluates to True.\n+\n+ if Present (Expr) then\n+ Analyze_And_Resolve (Expr, Any_Boolean);\n+\n+ if Is_OK_Static_Expression (Expr) then\n+ if Is_True (Static_Boolean (Expr)) then\n+ Set_Disable_Controlled (E);\n+ end if;\n+\n+ -- Otherwise the expression is not static\n+\n+ else\n+ Error_Msg_N\n+ (\"expression of aspect % must be static\", Aspect);\n+ end if;\n+\n+ -- Otherwise the aspect appears without an expression and\n+ -- defaults to True.\n+\n+ else\n+ Set_Disable_Controlled (E);\n+ end if;\n+ end if;\n+ end Analyze_Aspect_Disable_Controlled;\n+\n ----------------------------------\n -- Analyze_Aspect_Export_Import --\n ----------------------------------\n@@ -3468,34 +3525,7 @@\n -- Disable_Controlled\n \n elsif A_Id = Aspect_Disable_Controlled then\n- if Ekind (E) /= E_Record_Type\n- or else not Is_Controlled (E)\n- then\n- Error_Msg_N\n- (\"aspect % requires controlled record type\", Aspect);\n- goto Continue;\n- end if;\n-\n- -- If we're in a generic template, we don't want to try\n- -- to disable controlled types, because typical usage is\n- -- \"Disable_Controlled => not <some_check>'Enabled\", and\n- -- the value of Enabled is not known until we see a\n- -- particular instance. In such a context, we just need\n- -- to preanalyze the expression for legality.\n-\n- if Expander_Active then\n- Analyze_And_Resolve (Expr, Standard_Boolean);\n-\n- if not Present (Expr)\n- or else Is_True (Static_Boolean (Expr))\n- then\n- Set_Disable_Controlled (E);\n- end if;\n-\n- elsif Serious_Errors_Detected = 0 then\n- Preanalyze_And_Resolve (Expr, Standard_Boolean);\n- end if;\n-\n+ Analyze_Aspect_Disable_Controlled;\n goto Continue;\n end if;\n \n@@ -10839,8 +10869,8 @@\n \n E : constant Entity_Id := Entity (N);\n \n- Non_Generic_Case : constant Boolean := Nkind (N) = N_Freeze_Entity;\n- -- True in non-generic case. Some of the processing here is skipped\n+ Nongeneric_Case : constant Boolean := Nkind (N) = N_Freeze_Entity;\n+ -- True in nongeneric case. Some of the processing here is skipped\n -- for the generic case since it is not needed. Basically in the\n -- generic case, we only need to do stuff that might generate error\n -- messages or warnings.\n@@ -10867,7 +10897,7 @@\n -- This is not needed in the generic case\n \n if Ada_Version >= Ada_2005\n- and then Non_Generic_Case\n+ and then Nongeneric_Case\n and then Ekind (E) = E_Record_Type\n and then Is_Tagged_Type (E)\n and then not Is_Interface (E)\n@@ -11003,7 +11033,7 @@\n -- predefined primitives.\n \n if Is_Type (E)\n- and then Non_Generic_Case\n+ and then Nongeneric_Case\n and then not Within_Internal_Subprogram\n and then Has_Predicates (E)\n then\n@@ -11019,7 +11049,7 @@\n \n -- This is also not needed in the generic case\n \n- if Non_Generic_Case\n+ if Nongeneric_Case\n and then Has_Delayed_Aspects (E)\n and then Scope (E) = Current_Scope\n then\nIndex: sem_ch3.adb\n===================================================================\n--- sem_ch3.adb\t(revision 252062)\n+++ sem_ch3.adb\t(working copy)\n@@ -4848,7 +4848,7 @@\n and then not Is_Constrained (Underlying_Type (T))\n and then not Is_Aliased (Id)\n and then not Is_Class_Wide_Type (T)\n- and then not Is_Controlled_Active (T)\n+ and then not Is_Controlled (T)\n and then not Has_Controlled_Component (Base_Type (T))\n and then Expander_Active\n then\n@@ -6157,7 +6157,7 @@\n Set_Has_Controlled_Component\n (Implicit_Base,\n Has_Controlled_Component (Element_Type)\n- or else Is_Controlled_Active (Element_Type));\n+ or else Is_Controlled (Element_Type));\n Set_Packed_Array_Impl_Type\n (Implicit_Base, Empty);\n \n@@ -6178,7 +6178,7 @@\n Set_Has_Controlled_Component (T, Has_Controlled_Component\n (Element_Type)\n or else\n- Is_Controlled_Active (Element_Type));\n+ Is_Controlled (Element_Type));\n Set_Finalize_Storage_Only (T, Finalize_Storage_Only\n (Element_Type));\n Set_Default_SSO (T);\n@@ -7897,18 +7897,21 @@\n Error_Msg_N (\"cannot add discriminants to untagged type\", N);\n end if;\n \n- Set_Stored_Constraint (Derived_Type, No_Elist);\n- Set_Is_Constrained (Derived_Type, Is_Constrained (Parent_Type));\n- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));\n- Set_Disable_Controlled (Derived_Type, Disable_Controlled\n- (Parent_Type));\n+ Set_Stored_Constraint (Derived_Type, No_Elist);\n+ Set_Is_Constrained (Derived_Type, Is_Constrained (Parent_Type));\n+\n+ Set_Is_Controlled_Active\n+ (Derived_Type, Is_Controlled_Active (Parent_Type));\n+\n+ Set_Disable_Controlled\n+ (Derived_Type, Disable_Controlled (Parent_Type));\n+\n Set_Has_Controlled_Component\n- (Derived_Type, Has_Controlled_Component\n- (Parent_Type));\n+ (Derived_Type, Has_Controlled_Component (Parent_Type));\n \n -- Direct controlled types do not inherit Finalize_Storage_Only flag\n \n- if not Is_Controlled_Active (Parent_Type) then\n+ if not Is_Controlled (Parent_Type) then\n Set_Finalize_Storage_Only\n (Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type));\n end if;\n@@ -9206,9 +9209,10 @@\n and then Chars (Scope (Scope (Derived_Type))) = Name_Ada\n and then Scope (Scope (Scope (Derived_Type))) = Standard_Standard\n then\n- Set_Is_Controlled (Derived_Type);\n+ Set_Is_Controlled_Active (Derived_Type);\n else\n- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Base));\n+ Set_Is_Controlled_Active\n+ (Derived_Type, Is_Controlled_Active (Parent_Base));\n end if;\n \n -- Minor optimization: there is no need to generate the class-wide\n@@ -9475,20 +9479,21 @@\n begin\n -- Set common attributes\n \n- Set_Scope (Derived_Type, Current_Scope);\n-\n+ Set_Scope (Derived_Type, Current_Scope);\n Set_Etype (Derived_Type, Parent_Base);\n Set_Ekind (Derived_Type, Ekind (Parent_Base));\n Propagate_Concurrent_Flags (Derived_Type, Parent_Base);\n \n- Set_Size_Info (Derived_Type, Parent_Type);\n- Set_RM_Size (Derived_Type, RM_Size (Parent_Type));\n- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));\n+ Set_Size_Info (Derived_Type, Parent_Type);\n+ Set_RM_Size (Derived_Type, RM_Size (Parent_Type));\n+\n+ Set_Is_Controlled_Active\n+ (Derived_Type, Is_Controlled_Active (Parent_Type));\n+\n Set_Disable_Controlled (Derived_Type, Disable_Controlled (Parent_Type));\n+ Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));\n+ Set_Is_Volatile (Derived_Type, Is_Volatile (Parent_Type));\n \n- Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));\n- Set_Is_Volatile (Derived_Type, Is_Volatile (Parent_Type));\n-\n if Is_Tagged_Type (Derived_Type) then\n Set_No_Tagged_Streams_Pragma\n (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type));\n@@ -21799,7 +21804,7 @@\n end;\n end if;\n \n- Final_Storage_Only := not Is_Controlled_Active (T);\n+ Final_Storage_Only := not Is_Controlled (T);\n \n -- Ada 2005: Check whether an explicit Limited is present in a derived\n -- type declaration.\n@@ -21859,8 +21864,7 @@\n elsif not Is_Class_Wide_Equivalent_Type (T)\n and then (Has_Controlled_Component (Etype (Component))\n or else (Chars (Component) /= Name_uParent\n- and then Is_Controlled_Active\n- (Etype (Component))))\n+ and then Is_Controlled (Etype (Component))))\n then\n Set_Has_Controlled_Component (T, True);\n Final_Storage_Only :=\nIndex: sem_ch7.adb\n===================================================================\n--- sem_ch7.adb\t(revision 252062)\n+++ sem_ch7.adb\t(working copy)\n@@ -2644,7 +2644,8 @@\n end if;\n \n if Priv_Is_Base_Type then\n- Set_Is_Controlled (Priv, Is_Controlled (Full_Base));\n+ Set_Is_Controlled_Active\n+ (Priv, Is_Controlled_Active (Full_Base));\n Set_Finalize_Storage_Only\n (Priv, Finalize_Storage_Only (Full_Base));\n Set_Has_Controlled_Component\n", "prefixes": [ "Ada" ] }