[Ada] All assignments to abstract target objects must be disallowed

Message ID 20100622135403.GA3487@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 22, 2010, 1:54 p.m.
The compiler was permitting assignments to target objects of abstract
tagged types (such as when the target is a conversion to an abstract
type or a formal parameter of an abstract type). The original code
to catch this was only flagging the case where the target was of an
interface type. The new test flags assignments to any abstract object,
unless the assignment does not come from source (because there are
cases where the front end generates such an assignment in the _assign
operation of an abstract type).

Compilation of the following package must report this error:

abstract_assign_bug.adb:6:06: target of assignment operation must not be abstract

package Abstract_Assign_Bug is

  type Root is abstract tagged private;

  type T1 is new Root with private;

  procedure Reset (X : in out Root'Class);


  type Root is abstract tagged record
    I : Integer:= 11;
  end record;

  type T1 is new Root with record
    J : Integer:= 22;
  end record;

end Abstract_Assign_Bug;

package body Abstract_Assign_Bug is

  procedure Reset (X : in out Root'Class) is
     Y : T1;
     Root (X):= Root (Y);  -- ERROR: assignment to abstract target
  end Reset;

end Abstract_Assign_Bug;

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

2010-06-22  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch5.adb (Analyze_Assignment): Revise test for illegal assignment
	to abstract targets to check that the type is tagged and comes from
	source, rather than only testing for targets of interface types. Remove
	premature return.


Index: sem_ch5.adb
--- sem_ch5.adb	(revision 161073)
+++ sem_ch5.adb	(working copy)
@@ -448,14 +448,14 @@  package body Sem_Ch5 is
          end if;
-      --  Enforce RM 3.9.3 (8): left-hand side cannot be abstract
+      --  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
+      --  in the _assign operation for an abstract type).
-      elsif Is_Interface (T1)
-        and then not Is_Class_Wide_Type (T1)
-      then
+      elsif Is_Abstract_Type (T1) and then Comes_From_Source (N) then
-           ("target of assignment operation may not be abstract", Lhs);
-         return;
+           ("target of assignment operation must not be abstract", Lhs);
       end if;
       --  Resolution may have updated the subtype, in case the left-hand