===================================================================
@@ -6419,8 +6419,19 @@
else
Formal_P := Next_Entity (E);
- Check_Formal_Package_Instance (Formal_P, E);
+ -- If the instance is within an enclosing instance body
+ -- there is no need to vertify the legqlity of current
+ -- formsl psckages because they were legal in the generic
+ -- body. This optimixation may be applicable elsewhere,
+ -- and it also removes spurious errors that may arise with
+ -- on-the-fly inlining and confusion between private and
+ -- full views.
+
+ if not In_Instance_Body then
+ Check_Formal_Package_Instance (Formal_P, E);
+ end if;
+
-- After checking, remove the internal validating package.
-- It is only needed for semantic checks, and as it may
-- contain generic formal declarations it should not reach
This patch removes spurious errors appearing on a formal package of an instantiation nestled within an enclosing instance body. when the inner instance is a package that includes a subprogram with an Inline_Always aspect. The following must compile quietly: gnstmske -q -gnatws main --- with Def_Volume_Act_Conf; with Env_Volume_Act_Conf; with Iterate_On_Weekly_Values_General_G; package body Airspace_Utilities is procedure Iteration_On_Active_Configurations_G (Airspace_Uid : Env_Volume.T; During_Period : Period.T) is pragma Unreferenced (Airspace_Uid); procedure Local_Action (Activation_Info : Env_Volume_Act_Conf.T; The_Period : Period.T) is pragma Unreferenced (Activation_Info); procedure Config_Action (Subperiod : Period.T; Config : Env_Configuration.T) is begin Action (Subperiod, Config); end Config_Action; use Def_Volume_Act_Conf; procedure Iterate_On_Periods is new Iterate_On_Weekly_Values_General_G (Value_T => Env_Configuration.T, Interval_T => Def_Volume_Act_Conf.Base_Interval.T, Value_Weekly => Def_Volume_Act_Conf.Weekly, Action => Config_Action); begin Iterate_On_Periods (Activity => Def_Volume_Act_Conf.Weekly.None, Validity => The_Period); end Local_Action; procedure Iterate_On_Weekly_Activities is new Env_Volume_Act_Conf.Iteration_During_Period_G (Local_Action); begin Iterate_On_Weekly_Activities (Env_Volume.None, During_Period); end Iteration_On_Active_Configurations_G; procedure Set_Active (The_Airspace : Env_Volume.T) is procedure One_Configuration (Subperiod : Period.T; The_Configuration : Env_Configuration.T) is null; procedure Examine is new Iteration_On_Active_Configurations_G (Action => One_Configuration); pragma Compile_Time_Warning (True, "Instantiation fails with rather bogus error message."); begin Examine (The_Airspace, Period.None); end Set_Active; end Airspace_Utilities; --- with Env_Volume; with Env_Configuration; with Period; package Airspace_Utilities is generic with procedure Action (Subperiod : Period.T; Configurable_Uid : Env_Configuration.T); procedure Iteration_On_Active_Configurations_G (Airspace_Uid : Env_Volume.T; During_Period : Period.T); procedure Set_Active (The_Airspace : Env_Volume.T); end Airspace_Utilities; --- with Ada.Strings; generic type Bound_T is private; package Base_Interval_G is type T is private; private type T is array (Ada.Strings.Alignment) of Bound_T; pragma Compile_Time_Warning (True, "Indexed(?) type triggers the bug."); -- type T is null record; -- This version does not trigger the bug. end Base_Interval_G; --- with Base_Interval_G; with Env_Configuration; with General_Interval_Partition_G; with Time; package Def_Volume_Act_Conf is package Base_Interval is new Base_Interval_G (Bound_T => Time.Duration_T); package Weekly is new General_Interval_Partition_G (Item_T => Time.Duration_T, Interval_T => Base_Interval.T, Value_T => Env_Configuration.T); end Def_Volume_Act_Conf; --- with Env_Versioned_Value_Set_G; with Interfaces; package Env_Configuration is new Env_Versioned_Value_Set_G (Base_Uid_T => Interfaces.Integer_16); generic type Base_Uid_T is range <>; package Env_Versioned_Value_Set_G is type Base_T is new Base_Uid_T range Base_Uid_T'First .. Base_Uid_T'Last - 1; subtype T is Base_T range 0 .. Base_T'Last; subtype Uid_T is T; None : constant Uid_T := 0; end Env_Versioned_Value_Set_G; --- with Env_Versioned_Value_Set_G; with Interfaces; package Env_Volume is new Env_Versioned_Value_Set_G (Base_Uid_T => Interfaces.Integer_16); package body Env_Volume_Act_Conf is procedure Iteration_During_Period_G (Vol : Env_Volume.T; During_Period : Period.T) is pragma Unreferenced (Vol, During_Period); begin null; end Iteration_During_Period_G; end Env_Volume_Act_Conf; --- with Env_Volume; with Period; package Env_Volume_Act_Conf is type T is private; generic with procedure Action (Info : T; Validity : Period.T); pragma Unreferenced (Action); procedure Iteration_During_Period_G (Vol : Env_Volume.T; During_Period : Period.T); private type T is new Natural; end Env_Volume_Act_Conf; package body General_Interval_Partition_G is function Get (Partition : T; Key : Item_T) return Value_T is pragma Unreferenced (Partition, Key); begin return Result : Value_T do pragma Warnings (Off, Result); null; end return; end Get; end General_Interval_Partition_G; --- generic type Item_T is private; type Interval_T is private; pragma Unreferenced (Interval_T); pragma Compile_Time_Warning (True, "Type is required to trigger the bug."); type Value_T is private; package General_Interval_Partition_G is type T is private; None : constant T; -- BUG: If Inline_Always is specified, the instantiation fails! -- function Get (Partition : T; Key : Item_T) return Value_T; function Get (Partition : T; Key : Item_T) return Value_T with Inline_Always; pragma Compile_Time_Warning (True, "function declaration with Inline_Always triggers the bug."); private type T is new Natural; None : constant T := T'First; end General_Interval_Partition_G; --- procedure Iterate_On_Weekly_Values_General_G (Activity : Value_Weekly.T; Validity : Period.T) is pragma Unreferenced (Activity, Validity); begin null; end Iterate_On_Weekly_Values_General_G; --- with General_Interval_Partition_G; with Period; with Time; generic type Value_T is private; type Interval_T is private; with package Value_Weekly is new General_Interval_Partition_G (Item_T => Time.Duration_T, Interval_T => Interval_T, Value_T => Value_T); with procedure Action (Subperiod : Period.T; Value : Value_T); pragma Unreferenced (Action); procedure Iterate_On_Weekly_Values_General_G (Activity : Value_Weekly.T; Validity : Period.T); --- with Airspace_Utilities; with Env_Configuration; with Period; procedure Main is procedure Action (Subperiod : Period.T; Configurable_Uid : Env_Configuration.T) is null; procedure Iter is new Airspace_Utilities.Iteration_On_Active_Configurations_G (Action => Action); pragma Unreferenced (Iter); begin null; end Main; --- generic package Open_Interval_G is type T is private; None : constant T; private type T is null record; None : constant T := (others => <>); end Open_Interval_G; --- with Open_Interval_G; package Period is new Open_Interval_G; package Time is type Duration_T is private; Zero : constant Duration_T; One_Week : constant Duration_T; None_Duration : constant Duration_T; private type Duration_T is null record; None_Duration : constant Duration_T := (others => <>); Zero : constant Duration_T := (others => <>); One_Week : constant Duration_T := (others => <>); end Time; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-08 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Check_Formal_Packages): Do not apply conformance check if the instance is within an enclosing instance body. The formal package was legal in the enclosing generic, and is legal in the enclosing instantiation. This optimisation may be applicable elsewhere, and it also removes spurious errors that may arise with on-the-fly processing of instantiations that contain Inline_Always subprograms.