===================================================================
@@ -20383,6 +20383,17 @@
(Nearest_Dynamic_Scope
(Defining_Entity (Node_Par)));
+ -- For a return statement within a function, return
+ -- the depth of the function itself. This is not just
+ -- a small optimization, but matters when analyzing
+ -- the expression in an expression function before
+ -- the body is created.
+
+ when N_Simple_Return_Statement =>
+ if Ekind (Current_Scope) = E_Function then
+ return Scope_Depth (Current_Scope);
+ end if;
+
when others =>
null;
end case;
This patch fixes a spurious error on an expression function that is a completion, when the expression is a function call that returns an anonymous access type. The preanalysis of the expression to freeze referenced types requires the proper computation of the access level of the function call, at a point where the expression is not yet part of the generated tree for the body that represents the completion. The following must compile quietly: gcc -c print_interval_quotes.adb -- with Data_Serializer.Quote_Data; procedure Print_Interval_Quotes is begin null; end Print_Interval_Quotes; --- package Data_Serializer.Futures_Support is type Futures_Loader_Kind_Type is (Disabled, Default, Explicit); type Futures_Loader_Param_Type (Kind : Futures_Loader_Kind_Type := Disabled) is record case Kind is when Disabled | Default => null; when Explicit => Rollover_Offset : Duration; Matching_Offset : Duration; end case; end record; end Data_Serializer.Futures_Support; -- package body Data_Serializer.Generic_Per_Day_Data is function Default_Element (DS : Data_Source_Type) return Element_Type'Class is begin return Data_Wrapper_Type'((X => Null_D'Access)); end Default_Element; function Next_Pointer (DS : Data_Source_Type) return not null access constant Data_Type is begin return Null_D'Access; end Next_Pointer; function Next (DS : in out Data_Source_Type) return Element_Type'Class is (Data_Wrapper_Type'(X => Next_Pointer (DS))); function First (DS : Data_Source_Type) return Cursor_Type -- Setting "is (null)" removes the bug -- is (null); is -- begin return (Next_Pointer (DS)); -- end; end Data_Serializer.Generic_Per_Day_Data; --- generic type Data_Type is private; Null_Data : Data_Type; package Data_Serializer.Generic_Per_Day_data is Null_D : aliased constant Data_Type := Null_Data; type Data_Type_T_Array_Access is access Integer; type Data_Wrapper_Type (X : not null access constant Data_Type) is new Element_Type with null record with Implicit_Dereference => X; overriding function Timestamp (D : Data_Wrapper_Type) return Time is (0); type Data_Source_Type is limited new Source_Type with private; type Cursor_Type (<>) is private; function First (DS : Data_Source_Type) return Cursor_Type; private type Data_Source_Type_Access is not null access all Data_Source_Type; type Writable_Access (Self : not null access Data_Source_Type) is limited null record; type Data_Source_Type is limited new Source_Type with null record; type Cursor_Type is access constant Data_Type; end Data_Serializer.Generic_Per_Day_Data; --- with Data_Serializer.Generic_Per_Day_Data; with Quotes; package Data_Serializer.Quote_Data is new Data_Serializer.Generic_Per_Day_Data (Data_Type => Quotes.Quote_Type, Null_Data => Quotes.Null_Quote ); package Data_Serializer is type Time is new Integer; type Element_Type is interface; function Timestamp (E : Element_Type) return Time is abstract; type Source_Type is abstract tagged limited null record; end Data_Serializer; -- package Quotes is type Quote_Type is new Integer; Null_Quote : constant Quote_Type := 0; end Quotes; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-10-09 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Object_Access_Level): If the object is the return statement of an expression function, return the level of the function. This is relevant when the object involves an implicit conversion between access types and the expression function is a completion, which forces the analysis of the expression before rewriting it as a body, so that freeze nodes can appear in the proper scope.