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 <[email protected]>
* 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.
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);
