[Ada] Ada2020: AI12-0368 Declare expressions can be static
authorBob Duff <duff@adacore.com>
Thu, 28 May 2020 20:16:06 +0000 (16:16 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Fri, 10 Jul 2020 09:16:22 +0000 (05:16 -0400)
gcc/ada/

* sem_res.adb (Resolve_Expression_With_Actions): Check the rules
of AI12-0368, and mark the declare expression as static or known
at compile time as appropriate.
* sem_ch4.adb: Minor reformatting.
* libgnat/a-stoufo.ads, libgnat/a-stoufo.adb: Allow up to 9
replacement parameters. I'm planning to use this in the test
case for this ticket.

gcc/ada/libgnat/a-stoufo.adb
gcc/ada/libgnat/a-stoufo.ads
gcc/ada/sem_ch4.adb
gcc/ada/sem_res.adb

index 3b99cf7d03bead5f860d614751f84edaab874956..58d7f5a4be176a879d87265ffc612f151060c540 100644 (file)
@@ -38,10 +38,10 @@ package body Ada.Strings.Text_Output.Formatting is
 
    procedure Put
      (S : in out Sink'Class; T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
    is
       J : Positive := T'First;
-      Used : array (1 .. 6) of Boolean := (others => False);
+      Used : array (1 .. 9) of Boolean := (others => False);
    begin
       while J <= T'Last loop
          if T (J) = '\' then
@@ -78,6 +78,15 @@ package body Ada.Strings.Text_Output.Formatting is
                when '6' =>
                   Used (6) := True;
                   Put_UTF_8_Lines (S, X6);
+               when '7' =>
+                  Used (7) := True;
+                  Put_UTF_8_Lines (S, X7);
+               when '8' =>
+                  Used (8) := True;
+                  Put_UTF_8_Lines (S, X8);
+               when '9' =>
+                  Used (9) := True;
+                  Put_UTF_8_Lines (S, X9);
 
                when others =>
                   raise Program_Error;
@@ -107,32 +116,41 @@ package body Ada.Strings.Text_Output.Formatting is
       if not Used (6) then
          pragma Assert (X6 = "");
       end if;
+      if not Used (7) then
+         pragma Assert (X7 = "");
+      end if;
+      if not Used (8) then
+         pragma Assert (X8 = "");
+      end if;
+      if not Used (9) then
+         pragma Assert (X9 = "");
+      end if;
 
       Flush (S);
    end Put;
 
    procedure Put
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "") is
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
    begin
-      Put (Files.Standard_Output.all, T, X1, X2, X3, X4, X5, X6);
+      Put (Files.Standard_Output.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
    end Put;
 
    procedure Err
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "") is
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
    begin
-      Put (Files.Standard_Error.all, T, X1, X2, X3, X4, X5, X6);
+      Put (Files.Standard_Error.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
    end Err;
 
    function Format
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
      return UTF_8_Lines
    is
       Buf : Buffer := New_Buffer;
    begin
-      Put (Buf, T, X1, X2, X3, X4, X5, X6);
+      Put (Buf, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
       return Get_UTF_8 (Buf);
    end Format;
 
index dd80dff316065c0b813f6087b2abc8f7b9d5b3c3..a31ed2d4c12d948f6655cb27791164f0f3f1d157 100644 (file)
@@ -43,7 +43,7 @@ package Ada.Strings.Text_Output.Formatting is
    type Template is new UTF_8;
    procedure Put
      (S : in out Sink'Class; T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
    --  Prints the template as is, except for the following escape sequences:
    --    "\n" is end of line.
    --    "\i" indents by the default amount, and "\o" outdents.
@@ -57,17 +57,17 @@ package Ada.Strings.Text_Output.Formatting is
 
    procedure Put
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
    --  Sends to standard output
 
    procedure Err
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
    --  Sends to standard error
 
    function Format
      (T : Template;
-      X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+      X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
      return UTF_8_Lines;
    --  Returns a UTF-8-encoded String
 
index 3559a15c15291536254157a28c3d27064cc80878..517f5fc8bec6be50bc47348b2509caec6a3575bb 100644 (file)
@@ -2217,8 +2217,6 @@ package body Sem_Ch4 is
    -- Analyze_Expression_With_Actions --
    -------------------------------------
 
-   --  Start of processing for Analyze_Quantified_Expression
-
    procedure Analyze_Expression_With_Actions (N : Node_Id) is
 
       procedure Check_Action_OK (A : Node_Id);
index b5cdbb7593b1972f67ceecd6383609787c95168d..bea7a57aaa5137a743e470c9e3dd220c1eec1e1b 100644 (file)
@@ -8818,18 +8818,102 @@ package body Sem_Res is
    -------------------------------------
 
    procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is
+
+      function OK_For_Static (Act : Node_Id) return Boolean;
+      --  True if Act is an action of a declare_expression that is allowed in a
+      --  static declare_expression.
+
+      function All_OK_For_Static return Boolean;
+      --  True if all actions of N are allowed in a static declare_expression.
+
+      function Get_Literal (Expr : Node_Id) return Node_Id;
+      --  Expr is an expression with compile-time-known value. This returns the
+      --  literal node that reprsents that value.
+
+      function OK_For_Static (Act : Node_Id) return Boolean is
+      begin
+         case Nkind (Act) is
+            when N_Object_Declaration =>
+               if Constant_Present (Act)
+                 and then Is_Static_Expression (Expression (Act))
+               then
+                  return True;
+               end if;
+
+            when N_Object_Renaming_Declaration =>
+               if Statically_Names_Object (Name (Act)) then
+                  return True;
+               end if;
+
+            when others =>
+               --  No other declarations, nor even pragmas, are allowed in a
+               --  declare expression, so if we see something else, it must be
+               --  an internally generated expression_with_actions.
+               null;
+         end case;
+
+         return False;
+      end OK_For_Static;
+
+      function All_OK_For_Static return Boolean is
+         Act : Node_Id := First (Actions (N));
+      begin
+         while Present (Act) loop
+            if not OK_For_Static (Act) then
+               return False;
+            end if;
+
+            Next (Act);
+         end loop;
+
+         return True;
+      end All_OK_For_Static;
+
+      function Get_Literal (Expr : Node_Id) return Node_Id is
+         pragma Assert (Compile_Time_Known_Value (Expr));
+         Result : Node_Id;
+      begin
+         case Nkind (Expr) is
+            when N_Has_Entity =>
+               if Ekind (Entity (Expr)) = E_Enumeration_Literal then
+                  Result := Expr;
+               else
+                  Result := Constant_Value (Entity (Expr));
+               end if;
+            when N_Numeric_Or_String_Literal =>
+               Result := Expr;
+            when others =>
+               raise Program_Error;
+         end case;
+
+         pragma Assert
+           (Nkind (Result) in N_Numeric_Or_String_Literal
+              or else Ekind (Entity (Result)) = E_Enumeration_Literal);
+         return Result;
+      end Get_Literal;
+
+      Loc : constant Source_Ptr := Sloc (N);
+
    begin
       Set_Etype (N, Typ);
 
-      --  If N has no actions, and its expression has been constant folded,
-      --  then rewrite N as just its expression. Note, we can't do this in
-      --  the general case of Is_Empty_List (Actions (N)) as this would cause
-      --  Expression (N) to be expanded again.
+      if Is_Empty_List (Actions (N)) then
+         pragma Assert (All_OK_For_Static); null;
+      end if;
 
-      if Is_Empty_List (Actions (N))
-        and then Compile_Time_Known_Value (Expression (N))
-      then
-         Rewrite (N, Expression (N));
+      --  If the value of the expression is known at compile time, and all
+      --  of the actions (if any) are suitable, then replace the declare
+      --  expression with its expression. This allows the declare expression
+      --  as a whole to be static if appropriate. See AI12-0368.
+
+      if Compile_Time_Known_Value (Expression (N)) then
+         if Is_Empty_List (Actions (N)) then
+            Rewrite (N, Expression (N));
+         elsif All_OK_For_Static then
+            Rewrite
+              (N, New_Copy_Tree
+                    (Get_Literal (Expression (N)), New_Sloc => Loc));
+         end if;
       end if;
    end Resolve_Expression_With_Actions;