diff mbox series

[Ada] Misleading error or crash on illegal call with limited view

Message ID 20171109112551.GA90295@adacore.com
State New
Headers show
Series [Ada] Misleading error or crash on illegal call with limited view | expand

Commit Message

Pierre-Marie de Rodat Nov. 9, 2017, 11:25 a.m. UTC 
This patch provides a proper diagnostic on an illegal call to a function
whose return type is a limited view, when the call appears in a unit whose
context does not include the non-limited view of the type. Prior to this
patch the compiler reports a misleading error about a missing discriminant,
or aborts if compiler assertions are enabled.

Compiling check.adb must yield:

   check.adb:7:26: cannot call function that returns limited view of
      type "Object" defined at set.ads:7
   check.adb:7:26: there must be a regular with_clause for package "Set"
      in the current unit, or in some unit in its context

with View;
procedure Check is
   procedure Test  is
      Thing : View.Object;
   begin

      for Source of Thing.Sources loop
         null;
      end loop;
   end Test;

begin
   Null;
end Check;
ilimited with Set;

package view is

   type Object is tagged private;

   subtype Project_View is Object;

   Undefined : constant Object;

   function Sources (Self : Object) return Set.Object
     with Pre => Self /= Undefined;

private

   type Object is tagged record
      Id : Integer := 0;
   end record;
   Undefined : constant Object := (Id => -1);
end View;
---
with Ada.Iterator_Interfaces;
with Ada.Containers; 
private with Ada.Containers.Ordered_Sets;
package Set is

   type Object is tagged private
     with Constant_Indexing => Constant_Reference,
          Default_Iterator  => Iterate,
          Iterator_Element  => Integer;

   subtype Source_Set is Object;
   type Cursor is private;

   No_Element : constant Cursor;

   function Element (Position : Cursor) return Integer
     with Post =>
       (if Has_Element (Position)
         then Element'Result /= 0 else True);

   function Has_Element (Position : Cursor) return Boolean;

   package Source_Iterator is
     new Ada.Iterator_Interfaces (Cursor, Has_Element);

   type Constant_Reference_Type
     (Source : not null access constant Integer) is private
     with Implicit_Dereference => Source;

   function Constant_Reference
     (Self     : aliased Object;
      Position : Cursor) return Constant_Reference_Type;

   type Source_Filter is mod 2 ** 8;

   S_All        : constant Source_Filter;

   function Iterate
     (Self   : Object;
      Filter : Source_Filter := S_All)
      return Source_Iterator.Forward_Iterator'Class;

private

   package Set is new Ada.Containers.Ordered_Sets (Integer);

   type Object is tagged record
      S : Set.Set;
   end record;

   type Cursor is record
      Current : Set.Cursor;
   end record;

   No_Element : constant Cursor := (Current => Set.No_Element);

   type Constant_Reference_Type
     (Source : not null access constant Integer) is null record;

   S_All        : constant Source_Filter := 111;
end Set;

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

2017-11-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Call): Reject a call to a function that returns
	a limited view of a type T declared in unit U1, when the function is
	declared in another unit U2 and the call appears in a procedure within
	another unit.
diff mbox series

Patch

Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 254563)
+++ sem_ch4.adb	(working copy)
@@ -1520,6 +1520,27 @@ 
               and then Present (Non_Limited_View (Etype (N)))
             then
                Set_Etype (N, Non_Limited_View (Etype (N)));
+
+            --  If there is no completion for the type, this may be because
+            --  there is only a limited view of it and there is nothing in
+            --  the context of the current unit that has required a regular
+            --  compilation of the unit containing the type. We recognize
+            --  this unusual case by the fact that that unit is not analyzed.
+            --  Note that the call being analyzed is in a different unit from
+            --  the function declaration, and nothing indicates that the type
+            --  is a limited view.
+
+            elsif Ekind (Scope (Etype (N))) = E_Package
+              and then Present (Limited_View (Scope (Etype (N))))
+              and then not Analyzed (Unit_Declaration_Node (Scope (Etype (N))))
+            then
+               Error_Msg_NE ("cannot call function that returns "
+                 & "limited view of}", N, Etype (N));
+               Error_Msg_NE
+                 ("\there must be a regular with_clause for package& "
+                   & "in the current unit, or in some unit in its context",
+                    N, Scope (Etype (N)));
+               Set_Etype (N, Any_Type);
             end if;
          end if;
       end if;
@@ -8681,7 +8702,8 @@ 
          else
             --  The type of the subprogram may be a limited view obtained
             --  transitively from another unit. If full view is available,
-            --  use it to analyze call.
+            --  use it to analyze call. If there is no nonlimited view, then
+            --  this is diagnosed when analyzing the rewritten call.
 
             declare
                T : constant Entity_Id := Etype (Subprog);