In Ada2012, the expression that proides the body of an expression function must
be parenthesized. This patch improves the error recovery for what we expect to
be the common error of omitting those parentheses.

Compiling t.ads must yield:

   t.ads:21:06: expression function must be enclosed in parentheses

--
package T is
 Max_Length : constant Integer := 100;
 type Element_Type is range 0 .. 1_000_000;

 subtype Length_Range is Integer range 0 .. Max_Length;
 subtype Index_Range is Integer range 1..Max_Length;

 type Table is tagged private;

 procedure Insert (T : in out Table;
                   E : in Element_Type)
 with
   Pre'Class  => Allows_Insert(T, E),
   Post'Class =>
     ( Length(T) >= Length(T'Old) ) and
     ( Is_In(T, E ) and
     ( for all J in 1 .. Length(T'Old) => Is_In(T, Element_At(T'Old, J)) ));

 function Allows_Insert( T : Table;
                         E : Element_Type ) return Boolean is
     Length(T)<Max_Length; -- SYNTAX ERROR

 function Allows_Remove( T : Table;
                         E : Element_Type ) return Boolean;

private
 type Element_Array is array (1..Max_Length) of Element_Type;
 type Table is tagged record
    Length : Length_Range := 0;
    Data   : Element_Array;
 end record;
end T;

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

2011-09-05  Ed Schonberg  <schonb...@adacore.com>

        * par-ch6.adb (P_Subprogram): In Ada2012 mode, if the subprogram
        appears within a package specification and the token after "IS"
        is not a parenthesis, assume that this is an unparenthesized
        expression function, even if the token appears in a line by
        itself.
        * par.adb: Clarify use of Labl field of scope stack in error
        recovery.

Index: par.adb
===================================================================
--- par.adb     (revision 178381)
+++ par.adb     (working copy)
@@ -466,15 +466,22 @@
       --  control heuristic error recovery actions.
 
       Labl : Node_Id;
-      --  This field is used only for the LOOP and BEGIN cases, and is the
-      --  Node_Id value of the label name. For all cases except child units,
-      --  this value is an entity whose Chars field contains the name pointer
-      --  that identifies the label uniquely. For the child unit case the Labl
-      --  field references an N_Defining_Program_Unit_Name node for the name.
-      --  For cases other than LOOP or BEGIN, the Label field is set to Error,
-      --  indicating that it is an error to have a label on the end line.
+      --  This field is used to provide the name of the construct being parsed
+      --  and indirectly its kind. For loops and blocks, the field contains the
+      --  source name or the generated one. For package specifications, bodies,
+      --  subprogram specifications and bodies the field holds the correponding
+      --  program unit name. For task declarations and bodies, protected types
+      --  and bodies, and accept statements the field hold the name of the type
+      --  or operation. For if-statements, case-statements, and selects, the
+      --  field is initialized to Error, indicating that it is an error to have
+      --  a label on the end line.
       --  (this is really a misuse of Error since there is no Error ???)
 
+      --  Whenever the field is a name, it is attached to the parent node of
+      --  the construct being parsed. Thus the parent node indicates the kind
+      --  of construct whose parse tree is being built. This is used in error
+      --  recovery.
+
       Decl : List_Id;
       --  Points to the list of declarations (i.e. the declarative part)
       --  associated with this construct. It is set only in the END [name]
Index: par-ch6.adb
===================================================================
--- par-ch6.adb (revision 178401)
+++ par-ch6.adb (working copy)
@@ -675,11 +675,43 @@
                   else
                      --  If the identifier is the first token on its line, then
                      --  let's assume that we have a missing begin and this is
-                     --  intended as a subprogram body.
+                     --  intended as a subprogram body. However, if the context
+                     --  is a function and the unit is a package declaration, a
+                     --  body would be illegal, so try for an unparenthesized
+                     --  expression function.
 
                      if Token_Is_At_Start_Of_Line then
-                        return False;
+                        declare
 
+                           --  The enclosing scope entry is a subprogram spec.
+
+                           Spec_Node : constant Node_Id :=
+                            Parent (Scope.Table (Scope.Last).Labl);
+                           Lib_Node : Node_Id := Spec_Node;
+
+                        begin
+
+                           --  Check whether there is an enclosing scope that
+                           --  is a package declaration.
+
+                           if Scope.Last > 1 then
+                              Lib_Node  :=
+                                Parent (Scope.Table (Scope.Last - 1).Labl);
+                           end if;
+
+                           if Ada_Version >= Ada_2012
+                             and then
+                               Nkind (Lib_Node) = N_Package_Specification
+                             and then
+                               Nkind (Spec_Node) = N_Function_Specification
+                           then
+                              null;
+
+                           else
+                              return False;
+                           end if;
+                        end;
+
                      --  Otherwise we have to scan ahead. If the identifier is
                      --  followed by a colon or a comma, it is a declaration
                      --  and hence we have a subprogram body. Otherwise assume

Reply via email to