From d1e0b1be622e2beb55babe892691cc56ea20263d Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 3 Dec 2021 13:38:08 +0100 Subject: [PATCH] [Ada] Remove repeated routines for printing AST in Mixed_Case gcc/ada/ * osint.adb (To_Lower): Clarify that only To_Lower function causes bootstrap issues; fix style. * treepr.adb (Print_Str_Mixed_Case): Reuse existing case conversion routine. (To_Mixed): Rename from Capitalize; reuse System.Case_Util procedure and explain the bootstrap issue. --- gcc/ada/osint.adb | 5 ++++- gcc/ada/treepr.adb | 66 ++++++++++++++---------------------------------------- 2 files changed, 21 insertions(+), 50 deletions(-) diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index a8a6801..5e4f3fc 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1061,7 +1061,8 @@ package body Osint is function File_Names_Equal (File1, File2 : String) return Boolean is function To_Lower (A : String) return String; - -- For bootstrap reasons, we cannot use To_Lower from System.Case_Util + -- For bootstrap reasons, we cannot use To_Lower function from + -- System.Case_Util. -------------- -- To_Lower -- @@ -1074,6 +1075,8 @@ package body Osint is return Result; end To_Lower; + -- Start of processing for File_Names_Equal + begin if File_Names_Case_Sensitive then return File1 = File2; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 4980713..166667c 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -25,7 +25,6 @@ with Aspects; use Aspects; with Atree; use Atree; -with Csets; use Csets; with Debug; use Debug; with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; @@ -45,6 +44,7 @@ with Snames; use Snames; with Sinput; use Sinput; with Stand; use Stand; with Stringt; use Stringt; +with System.Case_Util; use System.Case_Util; with SCIL_LL; use SCIL_LL; with Uintp; use Uintp; with Urealp; use Urealp; @@ -135,9 +135,9 @@ package body Treepr is function From_Union is new Unchecked_Conversion (Union_Id, Uint); function From_Union is new Unchecked_Conversion (Union_Id, Ureal); - function Capitalize (S : String) return String; - procedure Capitalize (S : in out String); - -- Turns an identifier into Mixed_Case + function To_Mixed (S : String) return String; + -- Turns an identifier into Mixed_Case. For bootstrap reasons, we cannot + -- use To_Mixed function from System.Case_Util. function Image (F : Node_Or_Entity_Field) return String; @@ -255,35 +255,6 @@ package body Treepr is -- descendants are to be printed. Prefix_Str is to be added to all -- printed lines. - ---------------- - -- Capitalize -- - ---------------- - - procedure Capitalize (S : in out String) is - Cap : Boolean := True; - begin - for J in S'Range loop - declare - Old : constant Character := S (J); - begin - if Cap then - S (J) := Fold_Upper (S (J)); - else - S (J) := Fold_Lower (S (J)); - end if; - - Cap := Old = '_'; - end; - end loop; - end Capitalize; - - function Capitalize (S : String) return String is - begin - return Result : String (S'Range) := S do - Capitalize (Result); - end return; - end Capitalize; - ---------- -- Hash -- ---------- @@ -400,7 +371,7 @@ package body Treepr is when others => declare - Result : constant String := Capitalize (F'Img); + Result : constant String := To_Mixed (F'Img); begin return Result (3 .. Result'Last); -- Remove "F_" end; @@ -1713,22 +1684,8 @@ package body Treepr is -------------------------- procedure Print_Str_Mixed_Case (S : String) is - Ucase : Boolean; - begin - if Phase = Printing then - Ucase := True; - - for J in S'Range loop - if Ucase then - Write_Char (S (J)); - else - Write_Char (Fold_Lower (S (J))); - end if; - - Ucase := (S (J) = '_'); - end loop; - end if; + Print_Str (To_Mixed (S)); end Print_Str_Mixed_Case; ---------------- @@ -1862,6 +1819,17 @@ package body Treepr is Next_Serial_Number := Next_Serial_Number + 1; end Set_Serial_Number; + -------------- + -- To_Mixed -- + -------------- + + function To_Mixed (S : String) return String is + begin + return Result : String (S'Range) := S do + To_Mixed (Result); + end return; + end To_Mixed; + --------------- -- Tree_Dump -- --------------- -- 2.7.4