[Ada] Avoid crash for -gnatR -gnatc
authorBob Duff <duff@adacore.com>
Thu, 27 Jan 2022 16:13:41 +0000 (11:13 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Wed, 11 May 2022 08:53:17 +0000 (08:53 +0000)
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.)

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.

gcc/ada/repinfo.adb

index ed7312c..df30788 100644 (file)
@@ -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;