This patch fixes a compiler crash on an attempt to assign to a record component
whose type is the limited view of a classwide type.
Compiling
gcc -c c3a1004e.adb
must yield:
c3a1004e.adb:9:07: invalid use of limited view of "Department'CLASS"
---
limited with C3A1004E;
package C3A1004D is -- Departments
type Emp_Ptr is access all C3A1004E.Employee'Class;
type Department is tagged private;
private
subtype Dept_Name is String (1 .. 13);
type T_List is array (Positive range <>) of Emp_Ptr;
type Department is tagged record
Id : Dept_Name := "<<Dept_Name>>";
List : T_List (1 .. 5);
Tot : Natural := 0;
During_Mod : Boolean := False;
end record;
end C3A1004D;
---
package C3A1004E.Stub_Data is
type C3A1004D_Department_Class_Access is
access all C3A1004D.Department'Class;
type Stub_Data_Type_Assign_Employee_dacb0f_a2752f is record
D : C3A1004D_Department_Class_Access;
end record;
Stub_Data_Assign_Employee_dacb0f_a2752f :
Stub_Data_Type_Assign_Employee_dacb0f_a2752f;
end C3A1004E.Stub_Data;
---
with C3A1004E.Stub_Data; use C3A1004E.Stub_Data;
-- with C3A1004D; -- missing
package body C3A1004E
is
procedure Assign_Employee
(E : in out Employee;
D : in out C3A1004D.Department'Class) is
begin
D := Stub_Data.Stub_Data_Assign_Employee_dacb0f_a2752f.D.all;
end Assign_Employee;
end C3A1004E;
---
limited with C3A1004D;
package C3A1004E is -- Employees
type Dept_Ptr is access all C3A1004D.Department'Class;
type Employee is tagged private;
type Emp_Ptr is access all Employee'Class; -- used by function 'hire'
procedure Assign_Employee
(E : in out Employee;
D : in out C3A1004D.Department'Class);
private
type Employee is tagged record
Dept : Dept_Ptr;
Id : access String;
During_Mod : Boolean := False;
end record;
end C3A1004E;
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-11-18 Ed Schonberg <schonb...@adacore.com>
* sem_ch5.adb (Analyze_Assignment): Diagnose assignment where
left-hand side has a limited view of a class-wide type.
* sem_ch6.adb (Detected_And_Exchange): Do not install a non-limited
view if the scope of the type of the formal is visible through
a limited_with_clause, even if the non-limited view is available.
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 230522)
+++ sem_ch5.adb (working copy)
@@ -506,6 +506,15 @@
Ghost_Mode := Save_Ghost_Mode;
return;
+ -- A class-wide type may be a limited view. This illegal case is not
+ -- caught by previous checks.
+
+ elsif Ekind (T1) = E_Class_Wide_Type
+ and then From_Limited_With (T1)
+ then
+ Error_Msg_NE ("invalid use of limited view of&", Lhs, T1);
+ return;
+
-- Enforce RM 3.9.3 (8): the target of an assignment operation cannot be
-- abstract. This is only checked when the assignment Comes_From_Source,
-- because in some cases the expander generates such assignments (such
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 230526)
+++ sem_ch6.adb (working copy)
@@ -2786,7 +2786,10 @@
procedure Detect_And_Exchange (Id : Entity_Id);
-- Determine whether Id's type denotes an incomplete type associated
-- with a limited with clause and exchange the limited view with the
- -- non-limited one when available.
+ -- non-limited one when available. Note that the non-limited view
+ -- may exist because of a with_clause in another unit in the context,
+ -- but cannot be used because the current view of the enclosing unit
+ -- is still a limited view.
-------------------------
-- Detect_And_Exchange --
@@ -2795,7 +2798,10 @@
procedure Detect_And_Exchange (Id : Entity_Id) is
Typ : constant Entity_Id := Etype (Id);
begin
- if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then
+ if From_Limited_With (Typ)
+ and then Has_Non_Limited_View (Typ)
+ and then not From_Limited_With (Scope (Typ))
+ then
Set_Etype (Id, Non_Limited_View (Typ));
end if;
end Detect_And_Exchange;
