[Ada] Freezing subprogram that returns a limited view

[Arnaud Charlet <charlet at adacore dot com>]

This patch handles properly a function declared in package A that returns the
limited view of a type declared in package B, when the function is called from
a context that has with_clauses on A and B. Previous to this patch such a call
would crash the compiler because of a misplaced freeze node.

The following must compile quietly:

   gcc -c builder.adb

--
package body Builder is
   function "+"
    (Item : Wide_Wide_String) return Strings.Universal_String
       renames Strings.To_Universal_String;

   function Get_Document
    (Self : in out JSON_Builder) return Objects.JSON_Object is
   begin
      return Result : Objects.JSON_Object do
         Result.Insert (+"styles", Self.Styles.To_JSON_Value);
      end return;
   end Get_Document;

   not overriding procedure Leave_Text_Span
    (Self    : in out JSON_Builder;
     Element : not null Text_Span_Elements.ODF_Text_Span_Access) is
   begin
      Self.Current.Object.Insert
       (+"children", Self.Current.Children.To_JSON_Value);
   end Leave_Text_Span;
end Builder;
---
limited with Values;
package Arrays is
   pragma Preelaborate;

   type JSON_Array is tagged private;
   pragma Preelaborable_Initialization (JSON_Array);

   Empty_JSON_Array : constant JSON_Array;

   function To_JSON_Value
    (Self : JSON_Array'Class) return Values.JSON_Value;
private
   type JSON_Array is tagged record
      null;
   end record;

   Empty_JSON_Array : constant JSON_Array := (others => <>);
end Arrays;
---
with Objects;
with Arrays;
with Values;
private with Strings;
private with Text_Span_Elements;
package Builder is
   type JSON_Builder is tagged limited private;

   function Get_Document
      (Self : in out JSON_Builder) return Objects.JSON_Object;
private
   type State_Kinds is
    (Initial,
     Element);

   type State_Record (Kind : State_Kinds := Initial) is record
      case Kind is
         when Initial =>
            null;

         when Element =>
            Object   : Objects.JSON_Object;
            Children : Arrays.JSON_Array;
      end case;
   end record;

   type JSON_Builder is tagged limited record
      Current          : State_Record;
      Previous         : State_Record;
      Styles           : Arrays.JSON_Array;
   end record;

   not overriding procedure Leave_Text_Span
    (Self    : in out JSON_Builder;
     Element : not null Text_Span_Elements.ODF_Text_Span_Access);
end Builder;
---
with Strings;
limited with Values;
package Objects is
   pragma Preelaborate;

   type JSON_Object is tagged private;
   pragma Preelaborable_Initialization (JSON_Object);

   procedure Insert
    (Self  : in out JSON_Object'Class;
     Key   : Strings.Universal_String;
     Value : Values.JSON_Value);

private
   type JSON_Object is tagged record
      null;
   end record;
end Objects;
---
package Strings is
   pragma Preelaborate;

   type Universal_String is tagged private;

   function To_Universal_String
    (Item : Wide_Wide_String) return Universal_String;

private

   type Universal_String is tagged record
      null;
   end record;
end Strings;
---
package Text_Span_Elements is

   pragma Preelaborate;

   type ODF_Text_Span is limited interface;

   type ODF_Text_Span_Access is
     access all ODF_Text_Span'Class
       with Storage_Size => 0;
end Text_Span_Elements;
--
package Values is
   pragma Preelaborate;

   type JSON_Value is tagged private;
   pragma Preelaborable_Initialization (JSON_Value);

private
   type JSON_Value is tagged record
      null;
   end record;
end Values;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Late_Freeze_Subprogram): Following AI05-151,
	a function can return a limited view of a type declared
	elsewhere. In that case the function cannot be frozen at the end
	of its enclosing package. If its first use is in a different unit,
	it cannot be frozen there, but if the call is legal the full view
	of the return type is available and the subprogram can now be
	frozen. However the freeze node cannot be inserted at the point
	of call, but rather must go in the package holding the function,
	so that the backend can process it in the proper context.

Attachment: difs
Description: Text document