diff mbox

[Ada] Crash on overloaded function call with limited view

Message ID 20170120115518.GA64006@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Jan. 20, 2017, 11:55 a.m. UTC 
This patch fixes a compiler abort on a call to a function that returns a
limited view of a type. The following sources must compile quietly:

limited with Root;
package Api is
   type Object is tagged null record;

   function Is_Present (Name : in String) return Boolean;
   function Get (Name : in String) return Root.Object'Class;
end Api;

with Api;
package Root is
   type Object is new Api.Object with null record;
end Root;

with Root;
package body Api is
   function Get (Name : in String) return Root.Object'Class is
      B : Root.Object;
   begin
      return B;
   end Get;

   function Is_Present (Name : in String) return Boolean is
      O : constant Object'Class := Object'Class (Get (Name));
   begin
      return True;
   end Is_Present;
end Api;

Command: gcc -c api.adb

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

2017-01-20  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Call): If a function call
	returns a limited view of a type and at the point of the call the
	function is not declared in the extended main unit then replace
	it with the non-limited view, which must be available. If the
	called function is in the extended main unit then no action is
	needed since the back-end handles this case.
diff mbox

Patch

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 244700)
+++ sem_res.adb	(working copy)
@@ -6061,12 +6061,16 @@ 
          end;
 
       else
-         --  If the function returns the limited view of type, the call must
-         --  appear in a context in which the non-limited view is available.
-         --  As is done in Try_Object_Operation, use the available view to
-         --  prevent back-end confusion.
+         --  If the called function is not declared in the main unit and it
+         --  returns the limited view of type then use the available view (as
+         --  is done in Try_Object_Operation) to prevent back-end confusion;
+         --  the call must appear in a context where the nonlimited view is
+         --  available. If the called function is in the extended main unit
+         --  then no action is needed, because the back end handles this case.
 
-         if From_Limited_With (Etype (Nam)) then
+         if not In_Extended_Main_Code_Unit (Nam)
+           and then From_Limited_With (Etype (Nam))
+         then
             Set_Etype (Nam, Available_View (Etype (Nam)));
          end if;