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 <mira...@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.
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;