https://gcc.gnu.org/g:fd6638ce6467e0c88270924b3d35d14f9d766a0e
commit r17-937-gfd6638ce6467e0c88270924b3d35d14f9d766a0e Author: Marc Poulhiès <[email protected]> Date: Thu Mar 12 17:01:06 2026 +0100 ada: Add (r)pech debug routines for entity chains and simple check (r)pech (Print Entity Chain - Header) can be used to dump the entity chains with one node header per line: - N_Defining_Identifier "system__use_ada_main_program_name" (Entity_Id=2804) (source) - N_Defining_Identifier "system__zcx_by_default" (Entity_Id=2808) (source) - N_Defining_Identifier "system__standard_library" (Entity_Id=108628) (source) - N_Defining_Identifier "system__exception_table" (Entity_Id=109523) (source) Also add a simple consistency check to all routines that dumps the entity chain: if Prev (Next (E)) /= E (or Next (Prev (E)) /= E in the reverse order), an extra line is printed: - N_Defining_Identifier "system__tick" (Entity_Id=2550) (source) !! - Prev (Next (^^^^)) = N_Defining_Identifier "system__default_priority" (Entity_Id=2700) (source) - N_Defining_Identifier "system__address" (Entity_Id=2553) (source) This example shows that the next links have 2550->2553, but the previous links have 2700 <- 2553. gcc/ada/ChangeLog: * treepr.ads (pech, rpech): New. (Print_Entity_Chain): Adjust signature and comment to handle printing only header and doing the simple check. * treepr.adb (pech, rpech): New. (Print_Entity_Chain): Support for printing only headers and doing simple check. Diff: --- gcc/ada/treepr.adb | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++---- gcc/ada/treepr.ads | 29 +++++++++++++++++++++----- 2 files changed, 81 insertions(+), 9 deletions(-) diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 5df09a663f18..65c6585adcfc 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -445,6 +445,34 @@ package body Treepr is Pop_Output; end rpec; + ---------- + -- pech -- + ---------- + + procedure pech (From : Entity_Id) is + begin + Push_Output; + Set_Standard_Output; + + Print_Entity_Chain (From, Rev => False, Only_Header => True); + + Pop_Output; + end pech; + + ---------- + -- rpech -- + ---------- + + procedure rpech (From : Entity_Id) is + begin + Push_Output; + Set_Standard_Output; + + Print_Entity_Chain (From, Rev => True, Only_Header => True); + + Pop_Output; + end rpech; + -------- -- pl -- -------- @@ -634,7 +662,11 @@ package body Treepr is -- Print_Entity_Chain -- ------------------------ - procedure Print_Entity_Chain (From : Entity_Id; Rev : Boolean := False) is + procedure Print_Entity_Chain ( + From : Entity_Id; + Rev : Boolean := False; + Only_Header : Boolean := False) + is Ent : Entity_Id := From; begin Printing_Descendants := False; @@ -648,14 +680,35 @@ package body Treepr is Prefix_Char : constant Character := (if Present (Next_Ent) then '|' else ' '); begin - Print_Node (Ent, "", Prefix_Char); + if Only_Header then + Print_Str ("- "); + Print_Node_Header (Node_Id (Ent)); + else + Print_Node (Ent, "", Prefix_Char); + end if; + + if Present (Next_Ent) then + if not Rev + and then Prev_Entity (Next_Ent) /= Ent + then + Print_Str (" !! - Prev (Next (^^^^)) = "); + Print_Node_Header (Prev_Entity (Next_Ent)); + elsif Rev + and then Next_Entity (Next_Ent) /= Ent + then + Print_Str (" !! - Next (Prev (^^^^)) = "); + Print_Node_Header (Next_Entity (Next_Ent)); + end if; + end if; exit when No (Next_Ent); Ent := Next_Ent; - Print_Char ('|'); - Print_Eol; + if not Only_Header then + Print_Char ('|'); + Print_Eol; + end if; end; end loop; end Print_Entity_Chain; diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads index 880ba954139f..643ff028fb09 100644 --- a/gcc/ada/treepr.ads +++ b/gcc/ada/treepr.ads @@ -60,11 +60,19 @@ package Treepr is -- Prints the subtree consisting of the given element list and all its -- referenced descendants. - procedure Print_Entity_Chain (From : Entity_Id; Rev : Boolean := False); - -- Prints the entity chain From is on, starting from From. In other words, - -- prints From and then recursively follow the Next_Entity field. If Rev is - -- True, prints the chain backwards, i.e. follow the Last_Entity field - -- instead of Next_Entity. + procedure Print_Entity_Chain ( + From : Entity_Id; + Rev : Boolean := False; + Only_Header : Boolean := False); + -- Prints the entity chain from From. In other words, prints From and then + -- recursively follow the Next_Entity field. If Rev is True, prints the + -- chain backwards, i.e. follow the Prev_Entity field instead of + -- Next_Entity. It also prints an extra line in case the + -- Next_Entity/Prev_Entity links are inconsistent. i.e. + -- Prev_Entity (Next_Entity (E)) /= E. + -- + -- If Only_Header is True, only prints one line for each node instead of + -- printing the node and all its fields. -- The following debugging procedures are intended to be called from gdb. -- Note that in several cases there are synonyms which represent historical @@ -113,8 +121,19 @@ package Treepr is pragma Export (Ada, pec); -- Print From and the entities that follow it on its entity chain + procedure pech (From : Entity_Id); + pragma Export (Ada, pech); + -- Print node header for From and the entities that follow it on its entity + -- chain. + procedure rpec (From : Entity_Id); pragma Export (Ada, rpec); -- Like pec, but walk the entity chain backwards. The 'r' stands for -- "reverse". + + procedure rpech (From : Entity_Id); + pragma Export (Ada, rpech); + -- Like pech, but walk the entity chain backwards. The 'r' stands for + -- "reverse". + end Treepr;
