diff mbox

[Ada] Crash on function returning limited view of class-wide type

Message ID 20151118101100.GA53734@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 18, 2015, 10:11 a.m. UTC
THis patch fixes a compiler crash on a function that returns a class-wide
type, when the type is first obtained by means of a limited view.

The following must compile quietly:

---
with New_Network;
limited with New_Network.Bus;

package Topology is

   type Vertex
     (Nb_Terminals : New_Network.Terminal_Count) is tagged null record;

   function Get_Bus
     (Bus_Name : in New_Network.Name) return New_Network.Bus.Object'Class;
end Topology;
---
with New_Network.Bus;

package body Topology is

   function Get_Bus
     (Bus_Name : in New_Network.Name) return New_Network.Bus.Object'Class
   is
      O : New_Network.Bus.Object;
   begin
      return O;
   end Get_Bus;

end Topology;
---
package New_Network is

   --  General dimensioning named numbers

   Max_Element_Terminals : constant := 6;
   --  Max number of terminals an element or a bus can have

   Max_Bus_Terminals     : constant := 4;
   --  Max number of bonds a bus can have

   type Terminal_Count is range
     0 .. Integer'Max (Max_Bus_Terminals, Max_Element_Terminals);

   subtype Name is String
     with Dynamic_Predicate => Name'Length > 0;

end New_Network;
---
with Topology;
package New_Network.Bus is
   type Object is new Topology.Vertex (10) with null record;
end New_Network.Bus;

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

2015-11-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): A function declaration that
	returns a class-wide type must have freeing deferred, so that it
	is not frozen before the class-wide type and its root type are
	frozen. This is significant when there may be a limited view of
	the class_wide type in another package.
diff mbox

Patch

Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 230522)
+++ sem_ch6.adb	(working copy)
@@ -10423,6 +10423,17 @@ 
 
       if Nkind (Related_Nod) = N_Function_Specification then
          Analyze_Return_Type (Related_Nod);
+
+         --  If return type is class-wide, subprogram freezing may be
+         --  delayed as well.
+
+         if Is_Class_Wide_Type (Etype (Current_Scope))
+           and then not Is_Thunk (Current_Scope)
+           and then Nkind (Unit_Declaration_Node (Current_Scope)) =
+             N_Subprogram_Declaration
+         then
+            Set_Has_Delayed_Freeze (Current_Scope);
+         end if;
       end if;
 
       --  Now set the kind (mode) of each formal