[Ada] Missing error on implicit copy of limited value in expression function

[Ada] Missing error on implicit copy of limited value in expression function

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 852 bytes --]

This patch corrects an omission on the legality check of an allocator whose
expression is of a limited type, when the allocator is the expression of an
expression function.

Compiling t3.adb must yield:

  t3.adb:4:13: warning: not dispatching (must be defined in a package spec)
  t3.adb:5:07: initialization not allowed for limited types

---
procedure T3 is
   type X_T is tagged limited null record;
   type A_T is access X_T'Class;
   function Clone (X : X_T) return A_T is
     (new X_T'Class' (X_T'Class (X)));
   X : X_T;
   A : A_T := Clone (X);
begin
   null;
end T3;

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

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

	* sem_res.adb (Resolve_Allocator): Reject properly an allocator that
	attempts to copy a limited value, when the allocator is the expression
	in an expression function.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1120 bytes --]

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 253563)
+++ sem_res.adb	(working copy)
@@ -4834,10 +4834,18 @@
          --  are explicitly marked as coming from source but do not need to be
          --  checked for limited initialization. To exclude this case, ensure
          --  that the parent of the allocator is a source node.
+         --  The return statement constructed for an Expression_Function does
+         --  not come from source but requires a limited check.
 
          if Is_Limited_Type (Etype (E))
            and then Comes_From_Source (N)
-           and then Comes_From_Source (Parent (N))
+           and then
+             (Comes_From_Source (Parent (N))
+               or else
+                 (Ekind (Current_Scope) = E_Function
+                   and then Nkind
+                     (Original_Node (Unit_Declaration_Node (Current_Scope)))
+                       = N_Expression_Function))
            and then not In_Instance_Body
          then
             if not OK_For_Limited_Init (Etype (E), Expression (E)) then