* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Factor out

[pf3gnuchains/gcc-fork.git] / gcc / ada / par-ch4.adb

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 6bfc40a..f07f54e 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -79,6 +79,11 @@ package body Ch4 is
    --  Called to place complaint about bad range attribute at the given
    --  source location. Terminates by raising Error_Resync.
 
+   procedure P_Membership_Test (N : Node_Id);
+   --  N is the node for a N_In or N_Not_In node whose right operand has not
+   --  yet been processed. It is called just after scanning out the IN keyword.
+   --  On return, either Right_Opnd or Alternatives is set, as appropriate.
+
    function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
    --  Scan a range attribute reference. The caller has scanned out the
    --  prefix. The current token is known to be an apostrophe and the
@@ -453,7 +458,7 @@ package body Ch4 is
 
                         loop
                            Discard_Junk_Node (P_Expression_If_OK);
-                           exit when not Comma_Present;
+                           exit when not  Comma_Present;
                         end loop;
 
                         T_Right_Paren;
@@ -1386,6 +1391,19 @@ package body Ch4 is
 
             Append (Expr_Node, Expr_List);
 
+         --  Check for aggregate followed by left parent, maybe missing comma
+
+         elsif Nkind (Expr_Node) = N_Aggregate
+           and then Token = Tok_Left_Paren
+         then
+            T_Comma;
+
+            if No (Expr_List) then
+               Expr_List := New_List;
+            end if;
+
+            Append (Expr_Node, Expr_List);
+
          --  Anything else is assumed to be a named association
 
          else
@@ -1757,7 +1775,7 @@ package body Ch4 is
          --  Case of IN or NOT IN
 
          if Prev_Token = Tok_In then
-            Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
+            P_Membership_Test (Node2);
 
          --  Case of relational operator (= /= < <= > >=)
 
@@ -2088,8 +2106,18 @@ package body Ch4 is
       if not Token_Is_At_Start_Of_Line
          and then Token not in Token_Class_Sterm
       then
-         Error_Msg_AP ("binary operator expected");
+         --  Normally the right error message is indeed that we expected a
+         --  binary operator, but in the case of being between a right and left
+         --  paren, e.g. in an aggregate, a more likely error is missing comma.
+
+         if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
+            T_Comma;
+         else
+            Error_Msg_AP ("binary operator expected");
+         end if;
+
          raise Error_Resync;
+
       else
          return Node1;
       end if;
@@ -2658,7 +2686,7 @@ package body Ch4 is
 
    function P_Conditional_Expression return Node_Id is
       Exprs : constant List_Id    := New_List;
-      Loc   : constant Source_Ptr := Scan_Ptr;
+      Loc   : constant Source_Ptr := Token_Ptr;
       Expr  : Node_Id;
       State : Saved_Scan_State;
 
@@ -2734,4 +2762,42 @@ package body Ch4 is
           Expressions => Exprs);
    end P_Conditional_Expression;
 
+   -----------------------
+   -- P_Membership_Test --
+   -----------------------
+
+   procedure P_Membership_Test (N : Node_Id) is
+      Alt : constant Node_Id :=
+              P_Range_Or_Subtype_Mark
+                (Allow_Simple_Expression => Extensions_Allowed);
+
+   begin
+      --  Set case
+
+      if Token = Tok_Vertical_Bar then
+         if not Extensions_Allowed then
+            Error_Msg_SC ("set notation is a language extension");
+            Error_Msg_SC ("\|use -gnatX switch to compile this unit");
+         end if;
+
+         Set_Alternatives (N, New_List (Alt));
+         Set_Right_Opnd   (N, Empty);
+
+         --  Loop to accumulate alternatives
+
+         while Token = Tok_Vertical_Bar loop
+            Scan; -- past vertical bar
+            Append_To
+              (Alternatives (N),
+               P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
+         end loop;
+
+      --  Not set case
+
+      else
+         Set_Right_Opnd   (N, Alt);
+         Set_Alternatives (N, No_List);
+      end if;
+   end P_Membership_Test;
+
 end Ch4;