[Ada] Crash on overloaded function call with limited view

[Ada] Crash on overloaded function call with limited view

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1254 bytes --]

This patch fixes a compiler abort on a call that is initially overloaded,
when the resolved function returns the limited view of a type.

The folllowing must compile quietly:

   gcc -c p.adb

---
with R;

package body P is

   function Get (A : Q.Ptr) return Integer is
   begin
      return R.Conv (A.Get);
   end;

end P;
---
with Q;

package P is

   function Get (A : Q.Ptr) return Integer;

end P;
---
limited with R;

package Q is

   type Int1 is limited interface;

   function Get (Self : access Int1) return Integer is abstract;

   type Int2 is limited interface and Int1;

   function Get (Self : access Int2) return R.Rec2 is abstract;

   type Ptr is access all Int2'Class;

end Q;
---
package R is

   type Rec1 is tagged null record;

   function Conv (Item : Rec1) return Integer;

   type Rec2 is new Rec1 with null record;

end R;

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

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): If a function call returns a
	limited view of a type replace it with the non-limited view,
	which must be available when compiling call.  This was already
	done elsewhere for non-overloaded calls, but needs to be done
	after resolution if function name is overloaded.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 665 bytes --]

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 241024)
+++ sem_res.adb	(working copy)
@@ -6034,6 +6034,15 @@
          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 From_Limited_With (Etype (Nam)) then
+            Set_Etype (Nam, Available_View (Etype (Nam)));
+         end if;
+
          Set_Etype (N, Etype (Nam));
       end if;
 

[Ada] Crash on overloaded function call with limited view

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1249 bytes --]

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.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1197 bytes --]

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;