[gcc/devel/c++-coroutines] [Ada] Small enhancement in XEinfo utility

[Iain D Sandoe]

https://gcc.gnu.org/g:a2048d055bfe230b7074c492245ac041f739e471

commit a2048d055bfe230b7074c492245ac041f739e471
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Tue Mar 3 16:13:20 2020 +0100

    [Ada] Small enhancement in XEinfo utility
    
    2020-06-09  Eric Botcazou  <ebotcazou@adacore.com>
    
    gcc/ada/
    
            * einfo.ads (XEINFO section): Update format description.
            (Is_Subprogram_Or_Entry): Move pragma to regular section.
            (Is_Subprogram_Or_Generic_Subprogram): Likewise.
            * xeinfo.adb (Get_B4): Rename to...
            (Get_B0): ...this.
            (Translate_Expr): New procedure extracted from...
            (XEinfo): ...here.  Try to apply Get_B0 first and then
            call Translate_Expr to translate supported constructs.

Diff:
---
 gcc/ada/einfo.ads  | 16 +++++++++-------
 gcc/ada/xeinfo.adb | 44 +++++++++++++++++++++++++++++++++++---------
 2 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 4315fce8cd7..277ca989261 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -111,12 +111,14 @@ package Einfo is
 
 --     The function spec must be on a single line
 
---     There can only be a single statement, contained on a single line,
---     not counting any pragma Assert statements.
+--     There can only be a single return statement, not counting any pragma
+--     Assert statements, possibly followed by a comment.
 
---     This single statement must either be a function call with simple,
---     single token arguments, or it must be a membership test of the form
---     a in b, where a and b are single tokens.
+--     This single statement must either contain a function call with simple,
+--     single token arguments, or it must contain a membership test of the form
+--     a in b, where a and b are single tokens, or it must contain an equality
+--     or inequality test of single tokens, or it must contain a disjunction of
+--     the preceding constructs.
 
 --  For functions that are not inlined, there is no restriction on the body,
 --  and XEINFO generates a direct reference in the C header file which allows
@@ -8976,6 +8978,8 @@ package Einfo is
    pragma Inline (Is_Static_Type);
    pragma Inline (Is_Statically_Allocated);
    pragma Inline (Is_Subprogram);
+   pragma Inline (Is_Subprogram_Or_Entry);
+   pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
    pragma Inline (Is_Tag);
    pragma Inline (Is_Tagged_Type);
    pragma Inline (Is_Task_Type);
@@ -9170,8 +9174,6 @@ package Einfo is
    pragma Inline (Is_Protected_Component);
    pragma Inline (Is_Protected_Record_Type);
    pragma Inline (Is_String_Type);
-   pragma Inline (Is_Subprogram_Or_Entry);
-   pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
    pragma Inline (Is_Task_Record_Type);
    pragma Inline (Is_Volatile);
    pragma Inline (Is_Wrapper_Package);
diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb
index dfced53d15f..170a5c67028 100644
--- a/gcc/ada/xeinfo.adb
+++ b/gcc/ada/xeinfo.adb
@@ -126,10 +126,10 @@ procedure XEinfo is
    Get_Cmnt : constant Pattern := BreakX ('-') * A & "--";
    Get_Expr : constant Pattern := wsp & "return " & Break (';') * Expr;
    Chek_End : constant Pattern := wsp & "end" & BreakX (';') & ';';
+   Get_B0   : constant Pattern := BreakX (' ') * A & " or else " & Rest * B;
    Get_B1   : constant Pattern := BreakX (' ') * A & " in " & Rest * B;
    Get_B2   : constant Pattern := BreakX (' ') * A & " = " & Rest * B;
    Get_B3   : constant Pattern := BreakX (' ') * A & " /= " & Rest * B;
-   Get_B4   : constant Pattern := BreakX (' ') * A & " or else " & Rest * B;
    To_Paren : constant Pattern := wsp * Filler & '(';
    Get_Fml  : constant Pattern := Break (" :") * Formal & wsp & ':' & wsp
                                   & BreakX (" );") * Formaltyp;
@@ -164,6 +164,9 @@ procedure XEinfo is
    procedure Sethead (Line : in out VString; Term : String);
    --  Process function header into C
 
+   procedure Translate_Expr (Expr : in out VString);
+   --  Translate expression from Ada to C
+
    -------------
    -- Badfunc --
    -------------
@@ -242,6 +245,22 @@ procedure XEinfo is
       end if;
    end Sethead;
 
+   --------------------
+   -- Translate_Expr --
+   --------------------
+
+   procedure Translate_Expr (Expr : in out VString) is
+      M : Match_Result;
+
+   begin
+      Match (Expr, Get_B1, M);
+      Replace (M, "IN (" & A & ", " & B & ')');
+      Match (Expr, Get_B2, M);
+      Replace (M, A & " == " & B);
+      Match (Expr, Get_B3, M);
+      Replace (M, A & " != " & B);
+   end Translate_Expr;
+
 --  Start of processing for XEinfo
 
 begin
@@ -485,14 +504,21 @@ begin
             Badfunc;
          end if;
 
-         Match (Expr, Get_B1, M);
-         Replace (M, "IN (" & A & ", " & B & ')');
-         Match (Expr, Get_B2, M);
-         Replace (M, A & " == " & B);
-         Match (Expr, Get_B3, M);
-         Replace (M, A & " != " & B);
-         Match (Expr, Get_B4, M);
-         Replace (M, A & " || " & B);
+         --  Process expression
+
+         if Match (Expr, Get_B0, M) then
+            declare
+               Saved_A : VString := A;
+               Saved_B : VString := B;
+            begin
+               Translate_Expr (Saved_A);
+               Translate_Expr (Saved_B);
+               Replace (M, Saved_A & " || " & Saved_B);
+            end;
+         else
+            Translate_Expr (Expr);
+         end if;
+
          Put_Line (Ofile, "");
          Sethead (Fline, "");
          Put_Line (Ofile, C & "   { return " & Expr & "; }");