The kludge was added by Richard G. and me to help Ada when Richard was trying 
to remove the TYPE_IS_SIZETYPE flag from the middle-end 5 years ago, but it's 
not correct as witnessed by the attached testcase; and it's obsolete anyway.

Tested on x86_64-suse-linux, applied on the mainline as obvious.


2017-09-21  Eric Botcazou  <ebotca...@adacore.com>

        * stor-layout.c (bit_from_pos): Do not distribute the conversion.


2017-09-21  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/discr48.adb: New test.
        * gnat.dg/discr48_pkg.ads: New helper.

-- 
Eric Botcazou
Index: stor-layout.c
===================================================================
--- stor-layout.c	(revision 253049)
+++ stor-layout.c	(working copy)
@@ -853,14 +853,10 @@ start_record_layout (tree t)
 tree
 bit_from_pos (tree offset, tree bitpos)
 {
-  if (TREE_CODE (offset) == PLUS_EXPR)
-    offset = size_binop (PLUS_EXPR,
-			 fold_convert (bitsizetype, TREE_OPERAND (offset, 0)),
-			 fold_convert (bitsizetype, TREE_OPERAND (offset, 1)));
-  else
-    offset = fold_convert (bitsizetype, offset);
   return size_binop (PLUS_EXPR, bitpos,
-		     size_binop (MULT_EXPR, offset, bitsize_unit_node));
+		     size_binop (MULT_EXPR,
+				 fold_convert (bitsizetype, offset),
+				 bitsize_unit_node));
 }
 
 /* Return the combined truncated byte position for the byte offset OFFSET and
-- { dg-do compile }

with Discr48_Pkg; use Discr48_Pkg;

function Discr48 return Rec_Access is
   C : constant Rec := (Count => 1, Seps => (1 .. 0 => Null_XString));
begin
   return new Rec'(C);
end;
with Ada.Finalization;

package Discr48_Pkg is

   type XString is new Ada.Finalization.Controlled with record
      B : Boolean;
   end record;

   Null_XString : constant XString := (Ada.Finalization.Controlled with B => False);

   type XString_Array is array (Natural range <>) of XString;

   type Rec (Count : Positive) is record
      Seps : XString_Array (2 .. Count);
   end record;

   type Rec_Access is access all Rec;

end Discr48_Pkg;

Reply via email to