{"id":811589,"url":"http://patchwork.ozlabs.org/api/1.2/patches/811589/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/patch/20170908133133.GA87389@adacore.com/","project":{"id":17,"url":"http://patchwork.ozlabs.org/api/1.2/projects/17/?format=json","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":"<20170908133133.GA87389@adacore.com>","list_archive_url":null,"date":"2017-09-08T13:31:33","name":"[Ada] Spurious error on formal package with Inline_Always","commit_ref":null,"pull_url":null,"state":"new","archived":false,"hash":"668bde0e3305af52cbd430214e1bc92af5ab8712","submitter":{"id":4418,"url":"http://patchwork.ozlabs.org/api/1.2/people/4418/?format=json","name":"Arnaud Charlet","email":"charlet@adacore.com"},"delegate":null,"mbox":"http://patchwork.ozlabs.org/project/gcc/patch/20170908133133.GA87389@adacore.com/mbox/","series":[{"id":2209,"url":"http://patchwork.ozlabs.org/api/1.2/series/2209/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/list/?series=2209","date":"2017-09-08T13:31:33","name":"[Ada] Spurious error on formal package with Inline_Always","version":1,"mbox":"http://patchwork.ozlabs.org/series/2209/mbox/"}],"comments":"http://patchwork.ozlabs.org/api/patches/811589/comments/","check":"pending","checks":"http://patchwork.ozlabs.org/api/patches/811589/checks/","tags":{},"related":[],"headers":{"Return-Path":"","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-461725-incoming=patchwork.ozlabs.org@gcc.gnu.org;\n\treceiver=)","ozlabs.org; dkim=pass (1024-bit key;\n\tunprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org\n\theader.b=\"vphiOA6w\"; 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 3xpdXj57pkz9s82\n\tfor ;\n\tFri, 8 Sep 2017 23:32:21 +1000 (AEST)","(qmail 7199 invoked by alias); 8 Sep 2017 13:31:38 -0000","(qmail 7171 invoked by uid 89); 8 Sep 2017 13:31:37 -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 13:31:35 +0000","from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id 0AE935628A;\n\tFri, 8 Sep 2017 09:31:34 -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\t5RFbSFtepfxt; Fri, 8 Sep 2017 09:31:33 -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 E81D656285;\n\tFri, 8 Sep 2017 09:31:33 -0400 (EDT)","by tron.gnat.com (Postfix, from userid 4192)\tid E71424A4;\n\tFri, 8 Sep 2017 09:31:33 -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=MPURyHNFI2Xk0OtI7VX/QBuNKaoK11aw5VGVDQIppsCPfQrPyY\n\tHEItnvxu4E61meN9he/MNH96+WB5D7CoSXViMAxcoUjt2bRhg673rmPyc7BQAahs\n\tfvxQv2oIcXzDHKq6zZkFWyGmw2OHdRVJyKdh9mPIcG+1bonFAm1Qxh6/4=","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=ISbDYo0pse7OW7YiJppHTdMCUVY=; b=vphiOA6wko9Q0Ek1Y2cT\n\tGGS7oAEdWPAqya1ydSP8PYNomPCsRxttBd6Y8w8ZB7LAXxaT/E3wAOnIrkrsaoE5\n\tdjqoQL1GXEprSUHhGKgmxXhyYaCYUfk9ljwJA1a/u+VuN1Tl1as3xYGLtcuoUE1d\n\tPJI1R1qnIU5ao9si62VK/Ms=","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","X-Virus-Found":"No","X-Spam-SWARE-Status":"No, score=-11.9 required=5.0 tests=BAYES_00,\n\tFILL_THIS_FORM, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE,\n\tSPF_PASS autolearn=ham version=3.3.2 spammy=Weekly","X-HELO":"rock.gnat.com","Date":"Fri, 8 Sep 2017 09:31:33 -0400","From":"Arnaud Charlet ","To":"gcc-patches@gcc.gnu.org","Cc":"Ed Schonberg ","Subject":"[Ada] Spurious error on formal package with Inline_Always","Message-ID":"<20170908133133.GA87389@adacore.com>","MIME-Version":"1.0","Content-Type":"multipart/mixed; boundary=\"mYCpIKhGyMATD0i+\"","Content-Disposition":"inline","User-Agent":"Mutt/1.5.23 (2014-03-12)"},"content":"This patch removes spurious errors appearing on a formal package of\nan instantiation nestled within an enclosing instance body. when\nthe inner instance is a package that includes a subprogram with an\nInline_Always aspect.\n\nThe following must compile quietly:\n\ngnstmske -q -gnatws main\n\n---\nwith Def_Volume_Act_Conf;\nwith Env_Volume_Act_Conf;\nwith Iterate_On_Weekly_Values_General_G;\n\npackage body Airspace_Utilities is\n\n procedure Iteration_On_Active_Configurations_G (Airspace_Uid : Env_Volume.T;\n During_Period : Period.T) is\n pragma Unreferenced (Airspace_Uid);\n\n procedure Local_Action (Activation_Info : Env_Volume_Act_Conf.T;\n The_Period : Period.T) is\n pragma Unreferenced (Activation_Info);\n\n procedure Config_Action (Subperiod : Period.T;\n Config : Env_Configuration.T) is\n begin\n Action (Subperiod, Config);\n end Config_Action;\n\n use Def_Volume_Act_Conf;\n procedure Iterate_On_Periods is\n new Iterate_On_Weekly_Values_General_G (Value_T\n => Env_Configuration.T,\n Interval_T => Def_Volume_Act_Conf.Base_Interval.T,\n Value_Weekly => Def_Volume_Act_Conf.Weekly,\n Action => Config_Action);\n begin\n Iterate_On_Periods (Activity => Def_Volume_Act_Conf.Weekly.None,\n Validity => The_Period);\n end Local_Action;\n procedure Iterate_On_Weekly_Activities is\n new Env_Volume_Act_Conf.Iteration_During_Period_G (Local_Action);\n\n begin\n Iterate_On_Weekly_Activities\n (Env_Volume.None,\n During_Period);\n end Iteration_On_Active_Configurations_G;\n\n procedure Set_Active (The_Airspace : Env_Volume.T)\n is\n procedure One_Configuration (Subperiod : Period.T;\n The_Configuration : Env_Configuration.T) is null;\n procedure Examine is\n new Iteration_On_Active_Configurations_G (Action => One_Configuration);\n pragma Compile_Time_Warning (True,\n \"Instantiation fails with rather bogus error message.\");\n begin\n Examine (The_Airspace, Period.None);\n end Set_Active;\n\nend Airspace_Utilities;\n---\nwith Env_Volume;\nwith Env_Configuration;\nwith Period;\n\npackage Airspace_Utilities is\n\n generic\n with procedure Action (Subperiod : Period.T;\n Configurable_Uid : Env_Configuration.T);\n procedure Iteration_On_Active_Configurations_G (Airspace_Uid : Env_Volume.T;\n During_Period : Period.T);\n\n procedure Set_Active (The_Airspace : Env_Volume.T);\n\nend Airspace_Utilities;\n---\nwith Ada.Strings;\n\ngeneric\n\n type Bound_T is private;\n\npackage Base_Interval_G is\n\n type T is private;\n\nprivate\n\n type T is array (Ada.Strings.Alignment) of Bound_T;\n pragma Compile_Time_Warning (True, \"Indexed(?) type triggers the bug.\");\n\n -- type T is null record;\n -- This version does not trigger the bug.\n\nend Base_Interval_G;\n---\nwith Base_Interval_G;\nwith Env_Configuration;\nwith General_Interval_Partition_G;\nwith Time;\n\npackage Def_Volume_Act_Conf is\n\n package Base_Interval is new Base_Interval_G (Bound_T => Time.Duration_T);\n\n package Weekly is new General_Interval_Partition_G\n (Item_T => Time.Duration_T,\n Interval_T => Base_Interval.T,\n Value_T => Env_Configuration.T);\n\nend Def_Volume_Act_Conf;\n---\nwith Env_Versioned_Value_Set_G;\nwith Interfaces;\n\npackage Env_Configuration is\n new Env_Versioned_Value_Set_G (Base_Uid_T => Interfaces.Integer_16);\ngeneric\n\n type Base_Uid_T is range <>;\n\npackage Env_Versioned_Value_Set_G is\n\n type Base_T is new Base_Uid_T range Base_Uid_T'First .. Base_Uid_T'Last - 1;\n\n subtype T is Base_T range 0 .. Base_T'Last;\n\n subtype Uid_T is T;\n\n None : constant Uid_T := 0;\n\nend Env_Versioned_Value_Set_G;\n---\nwith Env_Versioned_Value_Set_G;\nwith Interfaces;\n\npackage Env_Volume is\n new Env_Versioned_Value_Set_G (Base_Uid_T => Interfaces.Integer_16);\npackage body Env_Volume_Act_Conf is\n\n procedure Iteration_During_Period_G (Vol : Env_Volume.T;\n During_Period : Period.T) is\n pragma Unreferenced (Vol, During_Period);\n begin\n null;\n end Iteration_During_Period_G;\n\nend Env_Volume_Act_Conf;\n---\nwith Env_Volume;\nwith Period;\n\npackage Env_Volume_Act_Conf is\n\n type T is private;\n\n generic\n with procedure Action (Info : T;\n Validity : Period.T);\n pragma Unreferenced (Action);\n procedure Iteration_During_Period_G (Vol : Env_Volume.T;\n During_Period : Period.T);\n\nprivate\n\n type T is new Natural;\n\nend Env_Volume_Act_Conf;\npackage body General_Interval_Partition_G is\n\n function Get (Partition : T; Key : Item_T) return Value_T is\n pragma Unreferenced (Partition, Key);\n begin\n return Result : Value_T\n do\n pragma Warnings (Off, Result);\n null;\n end return;\n end Get;\n\nend General_Interval_Partition_G;\n---\ngeneric\n type Item_T is private;\n\n type Interval_T is private;\n pragma Unreferenced (Interval_T);\n pragma Compile_Time_Warning (True, \"Type is required to trigger the bug.\");\n\n type Value_T is private;\n\npackage General_Interval_Partition_G is\n\n type T is private;\n\n None : constant T;\n\n -- BUG: If Inline_Always is specified, the instantiation fails!\n-- function Get (Partition : T; Key : Item_T) return Value_T;\n function Get (Partition : T; Key : Item_T) return Value_T with Inline_Always;\n pragma Compile_Time_Warning (True,\n \"function declaration with Inline_Always triggers the bug.\");\n\nprivate\n\n type T is new Natural;\n\n None : constant T := T'First;\n\nend General_Interval_Partition_G;\n---\nprocedure Iterate_On_Weekly_Values_General_G (Activity : Value_Weekly.T;\n Validity : Period.T) is\n pragma Unreferenced (Activity, Validity);\nbegin\n null;\nend Iterate_On_Weekly_Values_General_G;\n---\nwith General_Interval_Partition_G;\nwith Period;\nwith Time;\n\ngeneric\n\n type Value_T is private;\n\n type Interval_T is private;\n\n with package Value_Weekly is new General_Interval_Partition_G\n (Item_T => Time.Duration_T,\n Interval_T => Interval_T,\n Value_T => Value_T);\n\n with procedure Action (Subperiod : Period.T;\n Value : Value_T);\n pragma Unreferenced (Action);\n\nprocedure Iterate_On_Weekly_Values_General_G (Activity : Value_Weekly.T;\n Validity : Period.T);\n---\nwith Airspace_Utilities;\nwith Env_Configuration;\nwith Period;\n\nprocedure Main is\n procedure Action (Subperiod : Period.T;\n Configurable_Uid : Env_Configuration.T) is null;\n procedure Iter is new\n Airspace_Utilities.Iteration_On_Active_Configurations_G (Action => Action);\n pragma Unreferenced (Iter);\nbegin\n null;\nend Main;\n---\ngeneric\n\npackage Open_Interval_G is\n\n type T is private;\n\n None : constant T;\n\nprivate\n\n type T is null record;\n\n None : constant T := (others => <>);\n\nend Open_Interval_G;\n---\nwith Open_Interval_G;\n\npackage Period is new Open_Interval_G;\npackage Time is\n\n type Duration_T is private;\n\n Zero : constant Duration_T;\n One_Week : constant Duration_T;\n\n None_Duration : constant Duration_T;\n\nprivate\n\n type Duration_T is null record;\n\n None_Duration : constant Duration_T := (others => <>);\n Zero : constant Duration_T := (others => <>);\n One_Week : constant Duration_T := (others => <>);\n\nend Time;\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-08 Ed Schonberg \n\n\t* sem_ch12.adb (Check_Formal_Packages): Do not apply conformance\n\tcheck if the instance is within an enclosing instance body. The\n\tformal package was legal in the enclosing generic, and is\n\tlegal in the enclosing instantiation. This optimisation may be\n\tapplicable elsewhere, and it also removes spurious errors that\n\tmay arise with on-the-fly processing of instantiations that\n\tcontain Inline_Always subprograms.","diff":"Index: sem_ch12.adb\n===================================================================\n--- sem_ch12.adb\t(revision 251892)\n+++ sem_ch12.adb\t(working copy)\n@@ -6419,8 +6419,19 @@\n \n else\n Formal_P := Next_Entity (E);\n- Check_Formal_Package_Instance (Formal_P, E);\n \n+ -- If the instance is within an enclosing instance body\n+ -- there is no need to vertify the legqlity of current\n+ -- formsl psckages because they were legal in the generic\n+ -- body. This optimixation may be applicable elsewhere,\n+ -- and it also removes spurious errors that may arise with\n+ -- on-the-fly inlining and confusion between private and\n+ -- full views.\n+\n+ if not In_Instance_Body then\n+ Check_Formal_Package_Instance (Formal_P, E);\n+ end if;\n+\n -- After checking, remove the internal validating package.\n -- It is only needed for semantic checks, and as it may\n -- contain generic formal declarations it should not reach\n","prefixes":["Ada"]}