* [Ada] Avoid crash for -gnatR -gnatc
@ 2022-05-11 8:54 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-11 8:54 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
[-- Attachment #1: Type: text/plain, Size: 606 bytes --]
If the -gnatR -gnatc are both given, then the compiler crashes. This
patch fixes that, and avoids printing the uncomputed sizes and
alignments that were causing the crash. (Previous versions of the
compiler printed incorrect values in such cases.)
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* repinfo.adb (List_Object_Info): Do not try to print values
that have not been computed (and so are No_Uint).
(Rep_Not_Constant): Reverse sense and change name to
Compile_Time_Known_Rep. This makes the code at call sites a
little more readable. Simplify code to a single return
statement.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 4510 bytes --]
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -190,9 +190,9 @@ package body Repinfo is
procedure List_Type_Info (Ent : Entity_Id);
-- List type info for type Ent
- function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
- -- Returns True if Val represents a variable value, and False if it
- -- represents a value that is fixed at compile time.
+ function Compile_Time_Known_Rep (Val : Node_Ref_Or_Val) return Boolean;
+ -- Returns True if Val represents a representation value that is known at
+ -- compile time.
procedure Spaces (N : Natural);
-- Output given number of spaces
@@ -908,10 +908,12 @@ package body Repinfo is
procedure List_Object_Info (Ent : Entity_Id) is
begin
- -- The information has not been computed in a generic unit, so don't try
- -- to print it.
+ -- If size and alignment have not been computed (e.g. if we are in a
+ -- generic unit, or if the back end is not being run), don't try to
+ -- print them.
- if Sem_Util.In_Generic_Scope (Ent) then
+ pragma Assert (Known_Esize (Ent) = Known_Alignment (Ent));
+ if not Known_Alignment (Ent) then
return;
end if;
@@ -1055,20 +1057,7 @@ package body Repinfo is
Get_Decoded_Name_String (Chars (Comp));
Name_Length := Prefix_Length + Name_Len;
- if Rep_Not_Constant (Bofs) then
-
- -- If the record is not packed, then we know that all fields
- -- whose position is not specified have starting normalized
- -- bit position of zero.
-
- if not Known_Normalized_First_Bit (Comp)
- and then not Is_Packed (Ent)
- then
- Set_Normalized_First_Bit (Comp, Uint_0);
- end if;
-
- UI_Image_Length := 2; -- For "??" marker
- else
+ if Compile_Time_Known_Rep (Bofs) then
Npos := Bofs / SSU;
Fbit := Bofs mod SSU;
@@ -1098,6 +1087,18 @@ package body Repinfo is
end if;
UI_Image (Spos);
+ else
+ -- If the record is not packed, then we know that all fields
+ -- whose position is not specified have starting normalized
+ -- bit position of zero.
+
+ if not Known_Normalized_First_Bit (Comp)
+ and then not Is_Packed (Ent)
+ then
+ Set_Normalized_First_Bit (Comp, Uint_0);
+ end if;
+
+ UI_Image_Length := 2; -- For "??" marker
end if;
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
@@ -2118,18 +2119,14 @@ package body Repinfo is
end if;
end List_Type_Info;
- ----------------------
- -- Rep_Not_Constant --
- ----------------------
+ ----------------------------
+ -- Compile_Time_Known_Rep --
+ ----------------------------
- function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
+ function Compile_Time_Known_Rep (Val : Node_Ref_Or_Val) return Boolean is
begin
- if No (Val) or else Val < 0 then
- return True;
- else
- return False;
- end if;
- end Rep_Not_Constant;
+ return Present (Val) and then Val >= 0;
+ end Compile_Time_Known_Rep;
---------------
-- Rep_Value --
@@ -2408,24 +2405,20 @@ package body Repinfo is
procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
begin
- if Rep_Not_Constant (Val) then
- if List_Representation_Info < 3 or else No (Val) then
- Write_Unknown_Val;
-
- else
- if Paren then
- Write_Char ('(');
- end if;
+ if Compile_Time_Known_Rep (Val) then
+ UI_Write (Val, Decimal);
+ elsif List_Representation_Info < 3 or else No (Val) then
+ Write_Unknown_Val;
+ else
+ if Paren then
+ Write_Char ('(');
+ end if;
- List_GCC_Expression (Val);
+ List_GCC_Expression (Val);
- if Paren then
- Write_Char (')');
- end if;
+ if Paren then
+ Write_Char (')');
end if;
-
- else
- UI_Write (Val, Decimal);
end if;
end Write_Val;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-11 8:54 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-11 8:54 [Ada] Avoid crash for -gnatR -gnatc Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).