Patch Detail
get:
Show a patch.
patch:
Update a patch.
put:
Update a patch.
GET /api/patches/811392/?format=api
{ "id": 811392, "url": "http://patchwork.ozlabs.org/api/patches/811392/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/patch/20170908085959.GA68804@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": "<20170908085959.GA68804@adacore.com>", "list_archive_url": null, "date": "2017-09-08T08:59:59", "name": "[Ada] Infinite loop on an interface conversion involving private extensions.", "commit_ref": null, "pull_url": null, "state": "new", "archived": false, "hash": "8bbb574f78052ed91dcb357792bc1a3e9be04198", "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/20170908085959.GA68804@adacore.com/mbox/", "series": [ { "id": 2141, "url": "http://patchwork.ozlabs.org/api/series/2141/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/list/?series=2141", "date": "2017-09-08T08:59:59", "name": "[Ada] Infinite loop on an interface conversion involving private extensions.", "version": 1, "mbox": "http://patchwork.ozlabs.org/series/2141/mbox/" } ], "comments": "http://patchwork.ozlabs.org/api/patches/811392/comments/", "check": "pending", "checks": "http://patchwork.ozlabs.org/api/patches/811392/checks/", "tags": {}, "related": [], "headers": { "Return-Path": "<gcc-patches-return-461703-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-461703-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=\"qfMUbSfN\"; 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 3xpWWF1yCjz9sBZ\n\tfor <incoming@patchwork.ozlabs.org>;\n\tFri, 8 Sep 2017 19:00:41 +1000 (AEST)", "(qmail 101901 invoked by alias); 8 Sep 2017 09:00:29 -0000", "(qmail 97527 invoked by uid 89); 8 Sep 2017 09:00:18 -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 09:00:01 +0000", "from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id A8D8656260;\n\tFri, 8 Sep 2017 04:59:59 -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\tcYkTFzNCrBZB; Fri, 8 Sep 2017 04:59:59 -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 96AC55619D;\n\tFri, 8 Sep 2017 04:59:59 -0400 (EDT)", "by tron.gnat.com (Postfix, from userid 4192)\tid 95B1E505;\n\tFri, 8 Sep 2017 04:59:59 -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=SR6ibYaLC9IjkT54VriC+HhYxxP33ar9g9iiIVjLfW60sV0Zwq\n\t9A1Zieyc5k9WXTYC+BV0oc25vvNBJYkApjDtBh9lvmXxr4xFJwDGuKdkcOSyjOtj\n\tNVpLzWXTaAxYp8Q98vOXSxe1kG3uYg8HHZKQDmEUTAma54cAWtmEPD9NI=", "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=AU2msAm5uADW7mHZRRbkiLPo0Ow=; b=qfMUbSfNWOMAo0ZR/owh\n\tNMajmatR8kND8YT2y3KTWb8+3sfE1yiWnhoHzX65rZg0NQmwr3xndVgwOoeL0BNP\n\tFRcyM8RbxaF6go9dk9ZYkWdpg49HvVRlAOZY8BdvEihWVb/93IvUQ393hOoeXs3E\n\ttmnvFE5ksCD5i736IuD5LU8=", "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.9 required=5.0 tests=BAYES_00, GIT_PATCH_2,\n\tGIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS,\n\tT_FILL_THIS_FORM_SHORT autolearn=ham version=3.3.2\n\tspammy=communication", "X-HELO": "rock.gnat.com", "Date": "Fri, 8 Sep 2017 04:59:59 -0400", "From": "Arnaud Charlet <charlet@adacore.com>", "To": "gcc-patches@gcc.gnu.org", "Cc": "Ed Schonberg <schonberg@adacore.com>", "Subject": "[Ada] Infinite loop on an interface conversion involving private\n\textensions.", "Message-ID": "<20170908085959.GA68804@adacore.com>", "MIME-Version": "1.0", "Content-Type": "multipart/mixed; boundary=\"rwEMma7ioTxnRzrJ\"", "Content-Disposition": "inline", "User-Agent": "Mutt/1.5.23 (2014-03-12)" }, "content": "This patch fixes a loop in the compiler, on an interface conversion from an\ninterface declared as a synchronized private extension to one of its ancestors.\n\ndatabases-instantiations,adb below must compile quietly:\n\n---\npackage body Databases.Generics is\n New_Data_ID : Data_ID_Type := 1;\n\n protected body Database_Type is\n\n procedure Register\n (Data_Name : in Data_Name_Type;\n Data_ID : out Data_ID_Type)\n is\n Tmp_Data_ID : constant Data_ID_Type := New_Data_ID;\n begin\n Data_Names (Data_ID) := Data_Name;\n Data_Objects_Map (Data_ID) := Data_Object'\n (Data => Init_Data,\n Timestamp => Time_First);\n\n New_Data_ID := New_Data_ID + 1;\n\n Data_ID := Tmp_Data_ID;\n end Register;\n\n procedure Set\n (Data_ID : in Data_ID_Type;\n Raw_Data : in UInt8_Array)\n is\n Data : Data_Type with Address => Raw_Data'Address;\n begin\n Set\n (Data_ID => Data_ID,\n Data => Data);\n end Set;\n\n function Get\n (Data_ID : in Data_ID_Type) return UInt8_Array\n is\n Data_Size : constant Natural := Data_Type'Size / 8;\n Data : constant Data_Type := Get (Data_ID);\n Raw_Data : UInt8_Array (1 .. Data_Size) with Address => Data'Address;\n begin\n return Raw_Data;\n end Get;\n\n procedure Set\n (Data_ID : in Data_ID_Type;\n Data : in Data_Type)\n is\n begin\n Data_Objects_Map (Data_ID).Timestamp := Clock;\n Data_Objects_Map (Data_ID).Data := Data;\n end Set;\n\n function Get\n (Data_ID : in Data_ID_Type) return Data_Type is\n begin\n return Data_Objects_Map (Data_ID).Data;\n end Get;\n\n function Get_Timestamp\n (Data_ID : in Data_ID_Type) return Ada.Real_Time.Time is\n begin\n return Data_Objects_Map (Data_ID).Timestamp;\n end Get_Timestamp;\n\n end Database_Type;\n\n function Get_Database_Instance return Database_Access is\n begin\n return Database_Instance'Access;\n end Get_Database_Instance;\n\nend Databases.Generics;\nwith Ada.Real_Time; use Ada.Real_Time;\nwith Databases; use Databases;\ngeneric\n type Data_Type is private;\n -- The data type that should be stored in the database\n\n Init_Data : Data_Type;\n -- The value that should be set just after the data registration\n\n Max_Nb_Data : Positive;\n -- The maximun number of data that can be stored in the database\n\npackage Databases.Generics is\n\n type Typed_Database_Interface is synchronized interface;\n\n function Get\n (Database : Typed_Database_Interface;\n Data_ID : Data_ID_Type) return Data_Type is abstract;\n -- Get the currently set value for given Data_ID\n\n function Get_Timestamp\n (Database : Typed_Database_Interface;\n Data_ID : Data_ID_Type) return Time is abstract;\n\n procedure Set\n (Database : in out Typed_Database_Interface;\n Data_ID : Data_ID_Type;\n Data : Data_Type) is abstract;\n -- Set a value for the given Data_ID\n\n type Database_Type is synchronized new Root_Database_Type\n and Typed_Database_Interface with private;\n type Database_Access is access all Database_Type'Class;\n -- Database types for the given Data_Type.\n\n function Get_Database_Instance return Database_Access;\n -- Return the unique database instance for this package.\nprivate\n type Data_Object is record\n Data : Data_Type;\n Timestamp : Ada.Real_Time.Time;\n end record;\n\n type Data_Object_Array is\n array (Data_ID_Type'First .. Data_ID_Type (Max_Nb_Data)) of Data_Object;\n\n protected type Database_Type is new Root_Database_Type\n and Typed_Database_Interface with\n\n overriding procedure Register\n (Data_Name : in Data_Name_Type;\n Data_ID : out Data_ID_Type);\n\n overriding function Get\n (Data_ID : in Data_ID_Type) return UInt8_Array;\n\n overriding procedure Set\n (Data_ID : in Data_ID_Type;\n Raw_Data : UInt8_Array);\n\n overriding function Get\n (Data_ID : in Data_ID_Type) return Data_Type;\n -- Get the currently set value for given Data_ID\n\n overriding function Get_Timestamp\n (Data_ID : in Data_ID_Type) return Time;\n\n overriding procedure Set\n (Data_ID : in Data_ID_Type;\n Data : in Data_Type);\n -- Set a value for the given Data_ID\n private\n ID : Database_ID_Type := Get_New_Database_ID;\n Data_Objects_Map : Data_Object_Array;\n Data_Names : Data_Name_Array;\n end Database_Type;\n\n Database_Instance : aliased Database_Type;\n\nend Databases.Generics;\npackage body Databases.Instantiations is\n\n procedure Set_Raw_Data\n (Database_ID : Database_ID_Type;\n Data_ID : Data_ID_Type;\n Raw_Data : UInt8_Array) is\n begin\n Databases (Database_ID).Set\n (Data_ID => Data_ID,\n Raw_Data => Raw_Data);\n end Set_Raw_Data;\n\n function Get_Raw_Data\n (Database_ID : Database_ID_Type;\n Data_ID : Data_ID_Type)\n return UInt8_Array\n is\n begin\n return Databases (Database_ID).Get (Data_ID);\n end Get_Raw_Data;\n\nend Databases.Instantiations;\nwith Databases.Generics;\npackage Databases.Instantiations is\n\n procedure Set_Raw_Data\n (Database_ID : Database_ID_Type;\n Data_ID : Data_ID_Type;\n Raw_Data : UInt8_Array);\n -- Should be used by the Communication module.\n\n function Get_Raw_Data\n (Database_ID : Database_ID_Type;\n Data_ID : Data_ID_Type) return UInt8_Array;\n -- Should be used by the Communication module\n\n package Integer_Databases is new Databases.Generics\n (Integer,\n Init_Data => 0,\n Max_Nb_Data => 10);\n\n package Float_Databases is new Databases.Generics\n (Float,\n Init_Data => 0.0,\n Max_Nb_Data => 10);\nprivate\n First_ID : constant Database_ID_Type := Database_ID_Type'First;\n Last_ID : constant Database_ID_Type := Get_Last_Database_ID;\n\n Databases : constant Root_Database_Array (First_ID .. First_ID + 1) :=\n (First_ID => Root_Database_Access\n (Integer_Databases.Get_Database_Instance),\n First_ID + 1 => Root_Database_Access\n (Float_Databases.Get_Database_Instance));\n\nend Databases.Instantiations;\npackage body Databases is\n\n New_DB_ID : Database_ID_Type := 1;\n\n function Get_New_Database_ID return Database_ID_Type\n is\n DB_ID : constant Database_ID_Type := New_DB_ID;\n begin\n New_DB_ID := New_DB_ID + 1;\n\n return DB_ID;\n end Get_New_Database_ID;\n\n function Get_Last_Database_ID return Database_ID_Type is\n begin\n return New_DB_ID;\n end Get_Last_Database_ID;\n\nend Databases;\nwith Interfaces;\npackage Databases is\n\n type UInt8 is new Interfaces.Unsigned_8;\n type UInt8_Array is array (Natural range <>) of UInt8;\n\n subtype Data_Name_Type is String (1 .. 16);\n -- 16-Characters names used to register the data stored in databases\n\n type Database_ID_Type is private;\n -- Non-string based IDs for databases.\n -- Created when creating a new database instance.\n\n type Data_ID_Type is new Positive;\n -- Non-string based IDs for data stored in databases.\n -- Created when registering data in databases.\n\n type Root_Database_Type is synchronized interface;\n type Root_Database_Access is access all Root_Database_Type'Class;\n -- The root abstract type for all databases\n\n procedure Register\n (Database : in out Root_Database_Type;\n Data_Name : Data_Name_Type;\n Data_ID : out Data_ID_Type) is abstract;\n -- Register data to store in the given Database, associating it with\n -- Data_Name.\n -- The returned ID should be used for later transactions.\n\n function Get\n (Database : Root_Database_Type;\n Data_ID : Data_ID_Type) return UInt8_Array is abstract;\n -- Get the currently set value for given Data_ID in a raw data format\n\n procedure Set\n (Database : in out Root_Database_Type;\n Data_ID : Data_ID_Type;\n Raw_Data : UInt8_Array) is abstract;\n -- Set a raw data value for the given Data_ID\n\nprivate\n type Database_ID_Type is new Positive;\n\n type Root_Database_Array is\n array (Database_ID_Type range <>) of Root_Database_Access;\n\n type Data_Name_Array is array (Data_ID_Type'First .. 16) of Data_Name_Type;\n\n function Get_New_Database_ID return Database_ID_Type;\n -- Used to get a new database ID each time a databse is instantiated\n\n function Get_Last_Database_ID return Database_ID_Type;\n -- Return the lastly created database ID\nend Databases;\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-08 Ed Schonberg <schonberg@adacore.com>\n\n\t* sem_type.adb (Expand_Interface_Conversion): Prevent an infinite\n\tloop on an interface declared as a private extension of another\n\tsynchronized interface.", "diff": "Index: sem_type.adb\n===================================================================\n--- sem_type.adb\t(revision 251863)\n+++ sem_type.adb\t(working copy)\n@@ -2947,11 +2947,14 @@\n -- Continue climbing\n \n else\n- -- Use the full-view of private types (if allowed)\n+ -- Use the full-view of private types (if allowed).\n+ -- Guard against infinite loops when full view has same\n+ -- type as parent, as can happen with interface extensions,\n \n if Use_Full_View\n and then Is_Private_Type (Par)\n and then Present (Full_View (Par))\n+ and then Par /= Etype (Full_View (Par))\n then\n Par := Etype (Full_View (Par));\n else\n", "prefixes": [ "Ada" ] }