Patchwork [Ada] Improved error recovery for positional box

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 9, 2010, 8:51 a.m.
Message ID <20100909085119.GA8591@adacore.com>
Download mbox | patch
Permalink /patch/64261/
State New
Headers show

Comments

Arnaud Charlet - Sept. 9, 2010, 8:51 a.m.
This patch improves the error recovery for a box used in positional
notation in an aggregate (named notation is required for this case).

The following test is shown twice

     --  compiled with -gnat05

     1. package badbox is
     2.    x : string := (<>, 'a', 'b');
                          |
        >>> (Ada 2005) box only allowed with named notation

     3.    y : string := ('a', <>, 'b');
                               |
        >>> (Ada 2005) box only allowed with named notation

     4. end badbox;

     --  compiled with -gnat95

     1. package badbox is
     2.    x : string := (<>, 'a', 'b');
                          |
        >>> box in aggregate is an Ada 2005 extension
        >>> (Ada 2005) box only allowed with named notation

     3.    y : string := ('a', <>, 'b');
                               |
        >>> box in aggregate is an Ada 2005 extension
        >>> (Ada 2005) box only allowed with named notation

     4. end badbox;

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

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* par-ch4.adb (Box_Error): New procedure.

Patch

Index: par-ch4.adb
===================================================================
--- par-ch4.adb	(revision 164000)
+++ par-ch4.adb	(working copy)
@@ -1153,6 +1153,33 @@  package body Ch4 is
       Lparen_Sloc    : Source_Ptr;
       Scan_State     : Saved_Scan_State;
 
+      procedure Box_Error;
+      --  Called if <> is encountered as positional aggregate element. Issues
+      --  error message and sets Expr_Node to Error.
+
+      ---------------
+      -- Box_Error --
+      ---------------
+
+      procedure Box_Error is
+      begin
+         if Ada_Version < Ada_2005 then
+            Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
+         end if;
+
+         --  Ada 2005 (AI-287): The box notation is allowed only with named
+         --  notation because positional notation might be error prone. For
+         --  example, in "(X, <>, Y, <>)", there is no type associated with
+         --  the boxes, so you might not be leaving out the components you
+         --  thought you were leaving out.
+
+         Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
+         Scan; -- past box
+         Expr_Node := Error;
+      end Box_Error;
+
+   --  Start of processsing for P_Aggregate_Or_Paren_Expr
+
    begin
       Lparen_Sloc := Token_Ptr;
       T_Left_Paren;
@@ -1196,26 +1223,17 @@  package body Ch4 is
             end if;
          end if;
 
-         --  Ada 2005 (AI-287): The box notation is allowed only with named
-         --  notation because positional notation might be error prone. For
-         --  example, in "(X, <>, Y, <>)", there is no type associated with
-         --  the boxes, so you might not be leaving out the components you
-         --  thought you were leaving out.
+         --  Scan expression, handling box appearing as positional argument
 
-         if Ada_Version >= Ada_05 and then Token = Tok_Box then
-            Error_Msg_SC ("(Ada 2005) box notation only allowed with "
-                          & "named notation");
-            Scan; --  past BOX
-            Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
-            return Aggregate_Node;
+         if Token = Tok_Box then
+            Box_Error;
+         else
+            Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
          end if;
 
-         Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
-
          --  Extension aggregate case
 
          if Token = Tok_With then
-
             if Nkind (Expr_Node) = N_Attribute_Reference
               and then Attribute_Name (Expr_Node) = Name_Range
             then
@@ -1316,8 +1334,7 @@  package body Ch4 is
                              "extension aggregate");
             raise Error_Resync;
 
-         --  A range attribute can only appear as part of a discrete choice
-         --  list.
+         --  Range attribute can only appear as part of a discrete choice list
 
          elsif Nkind (Expr_Node) = N_Attribute_Reference
            and then Attribute_Name (Expr_Node) = Name_Range
@@ -1386,11 +1403,17 @@  package body Ch4 is
             exit;
          end if;
 
+         --  Deal with misused box
+
+         if Token = Tok_Box then
+            Box_Error;
+
          --  Otherwise initiate for reentry to top of loop by scanning an
          --  initial expression, unless the first token is OTHERS.
 
-         if Token = Tok_Others then
+         elsif Token = Tok_Others then
             Expr_Node := Empty;
+
          else
             Save_Scan_State (Scan_State); -- at start of expression
             Expr_Node := P_Expression_Or_Range_Attribute_If_OK;