From a2048d055bfe230b7074c492245ac041f739e471 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Mar 2020 16:13:20 +0100 Subject: [PATCH] [Ada] Small enhancement in XEinfo utility 2020-06-09 Eric Botcazou 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. --- 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 & "; }"); -- 2.30.2