diff gcc/ada/par-ch4.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
line wrap: on
line diff
--- a/gcc/ada/par-ch4.adb	Thu Oct 25 07:37:49 2018 +0900
+++ b/gcc/ada/par-ch4.adb	Thu Feb 13 11:34:05 2020 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -81,6 +81,8 @@
    function P_Primary                                 return Node_Id;
    function P_Relation                                return Node_Id;
    function P_Term                                    return Node_Id;
+   function P_Reduction_Attribute_Reference (S : Node_Id)
+      return Node_Id;
 
    function P_Binary_Adding_Operator                  return Node_Kind;
    function P_Logical_Operator                        return Node_Kind;
@@ -1202,12 +1204,48 @@
       return Attr_Node;
    end P_Range_Attribute_Reference;
 
+   -------------------------------------
+   -- P_Reduction_Attribute_Reference --
+   -------------------------------------
+
+   function P_Reduction_Attribute_Reference (S : Node_Id)
+      return Node_Id
+   is
+      Attr_Node  : Node_Id;
+      Attr_Name  : Name_Id;
+
+   begin
+      Attr_Name := Token_Name;
+      Scan;   --  past Reduce
+      Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
+      Set_Attribute_Name (Attr_Node, Attr_Name);
+      if Attr_Name /= Name_Reduce then
+         Error_Msg ("reduce attribute expected", Prev_Token_Ptr);
+      end if;
+
+      Set_Prefix (Attr_Node, S);
+      Set_Expressions (Attr_Node, New_List);
+      T_Left_Paren;
+      Append (P_Name, Expressions (Attr_Node));
+      T_Comma;
+      Append (P_Expression, Expressions (Attr_Node));
+      T_Right_Paren;
+
+      return Attr_Node;
+   end P_Reduction_Attribute_Reference;
+
    ---------------------------------------
    -- 4.1.4  Range Attribute Designator --
    ---------------------------------------
 
    --  Parsed by P_Range_Attribute_Reference (4.4)
 
+   ---------------------------------------------
+   -- 4.1.4 (2) Reduction_Attribute_Reference --
+   ---------------------------------------------
+
+   --  parsed by P_Reduction_Attribute_Reference
+
    --------------------
    -- 4.3  Aggregate --
    --------------------
@@ -1229,6 +1267,7 @@
       if Nkind (Aggr_Node) /= N_Aggregate
            and then
          Nkind (Aggr_Node) /= N_Extension_Aggregate
+         and then Ada_Version < Ada_2020
       then
          Error_Msg
            ("aggregate may not have single positional component", Aggr_Sloc);
@@ -1343,7 +1382,21 @@
 
    begin
       Lparen_Sloc := Token_Ptr;
-      T_Left_Paren;
+      if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then
+         Scan;
+
+         --  Special case for null aggregate in Ada2020.
+
+         if Token = Tok_Right_Bracket then
+            Scan;   --  past ]
+            Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
+            Set_Expressions (Aggregate_Node, New_List);
+            Set_Is_Homogeneous_Aggregate (Aggregate_Node);
+            return Aggregate_Node;
+         end if;
+      else
+         T_Left_Paren;
+      end if;
 
       --  Note on parentheses count. For cases like an if expression, the
       --  parens here really count as real parentheses for the paren count,
@@ -1577,6 +1630,14 @@
 
             Append (Expr_Node, Expr_List);
 
+         elsif Token = Tok_Right_Bracket then
+            if No (Expr_List) then
+               Expr_List := New_List;
+            end if;
+
+            Append (Expr_Node, Expr_List);
+            exit;
+
          --  Anything else is assumed to be a named association
 
          else
@@ -1625,7 +1686,19 @@
 
       --  All component associations (positional and named) have been scanned
 
-      T_Right_Paren;
+      if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then
+         Set_Component_Associations (Aggregate_Node, Assoc_List);
+         Set_Is_Homogeneous_Aggregate (Aggregate_Node);
+         Scan;  --  past right bracket
+         if Token = Tok_Apostrophe then
+            Scan;
+            if Token = Tok_Identifier then
+               return P_Reduction_Attribute_Reference (Aggregate_Node);
+            end if;
+         end if;
+      else
+         T_Right_Paren;
+      end if;
 
       if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
          Set_Expressions (Aggregate_Node, Expr_List);
@@ -1884,7 +1957,7 @@
    --  called in all contexts where a right parenthesis cannot legitimately
    --  follow an expression.
 
-   --  Error recovery: can not raise Error_Resync
+   --  Error recovery: cannot raise Error_Resync
 
    function P_Expression_No_Right_Paren return Node_Id is
       Expr : constant Node_Id := P_Expression;
@@ -2262,7 +2335,7 @@
          --  capacity-exceeded error. The purpose of this trick is to avoid
          --  creating a deeply nested tree, which would cause deep recursion
          --  during semantics, causing stack overflow. This way, we can handle
-         --  enormous concatenations in the normal case of predefined "&".  We
+         --  enormous concatenations in the normal case of predefined "&". We
          --  first build up the normal tree, and then rewrite it if
          --  appropriate.
 
@@ -2623,6 +2696,7 @@
    --  | STRING_LITERAL   | AGGREGATE
    --  | NAME             | QUALIFIED_EXPRESSION
    --  | ALLOCATOR        | (EXPRESSION) | QUANTIFIED_EXPRESSION
+   --  | REDUCTION_ATTRIBUTE_REFERENCE
 
    --  Error recovery: can raise Error_Resync
 
@@ -2715,6 +2789,9 @@
                   return Expr;
                end;
 
+            when Tok_Left_Bracket =>
+               return P_Aggregate;
+
             --  Allocator
 
             when Tok_New =>
@@ -2850,7 +2927,7 @@
 
             when Tok_At_Sign =>  --  AI12-0125 : target_name
                if Ada_Version < Ada_2020 then
-                  Error_Msg_SC ("target name is an Ada 2020 extension");
+                  Error_Msg_SC ("target name is an Ada 202x feature");
                   Error_Msg_SC ("\compile with -gnatX");
                end if;
 
@@ -3325,7 +3402,7 @@
       Set_Expression (Assoc_Node, P_Expression);
 
       if Ada_Version < Ada_2020 then
-         Error_Msg_SC ("iterated component is an Ada 2020 extension");
+         Error_Msg_SC ("iterated component is an Ada 202x feature");
          Error_Msg_SC ("\compile with -gnatX");
       end if;