[Ada] Fix GIMPLE checking failure on broken code

[Ada] Fix GIMPLE checking failure on broken code

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 519 bytes --]

Because of questionable unchecked conversions.

Tested on x86-64/Linux, applied on mainline.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/utils.c (unchecked_convert): Tweak comment.  Only skip
	dereferences when padding to have the same size on both sides.  Do it
	for destination types with self-referential size too.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/unchecked_convert1.ads: New test.
	* gnat.dg/specs/unchecked_convert2.ads: Likewise.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 2719 bytes --]

Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 272820)
+++ gcc-interface/utils.c	(working copy)
@@ -5265,8 +5265,8 @@ unchecked_convert (tree type, tree expr,
   if (etype == type)
     return expr;
 
-  /* If both types are integral just do a normal conversion.
-     Likewise for a conversion to an unconstrained array.  */
+  /* If both types are integral or regular pointer, then just do a normal
+     conversion.  Likewise for a conversion to an unconstrained array.  */
   if (((INTEGRAL_TYPE_P (type)
 	|| (POINTER_TYPE_P (type) && !TYPE_IS_THIN_POINTER_P (type))
 	|| (code == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (type)))
@@ -5397,14 +5397,16 @@ unchecked_convert (tree type, tree expr,
      we need to pad to have the same size on both sides.
 
      ??? We cannot do it unconditionally because unchecked conversions are
-     used liberally by the front-end to implement polymorphism, e.g. in:
+     used liberally by the front-end to implement interface thunks:
 
+       type ada__tags__addr_ptr is access system.address;
        S191s : constant ada__tags__addr_ptr := ada__tags__addr_ptr!(S190s);
        return p___size__4 (p__object!(S191s.all));
 
-     so we skip all expressions that are references.  */
-  else if (!REFERENCE_CLASS_P (expr)
+     so we need to skip dereferences.  */
+  else if (!INDIRECT_REF_P (expr)
 	   && !AGGREGATE_TYPE_P (etype)
+	   && ecode != UNCONSTRAINED_ARRAY_TYPE
 	   && TREE_CONSTANT (TYPE_SIZE (type))
 	   && (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type))))
     {
@@ -5414,6 +5416,31 @@ unchecked_convert (tree type, tree expr,
 					  false, false, false, true),
 			  expr);
 	  expr = unchecked_convert (type, expr, notrunc_p);
+	}
+      else
+	{
+	  tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
+					  false, false, false, true);
+	  expr = unchecked_convert (rec_type, expr, notrunc_p);
+	  expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
+	}
+    }
+
+  /* Likewise if we are converting from a scalar type to a type with self-
+     referential size.  We use the max size to do the padding in this case.  */
+  else if (!INDIRECT_REF_P (expr)
+	   && !AGGREGATE_TYPE_P (etype)
+	   && ecode != UNCONSTRAINED_ARRAY_TYPE
+	   && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (type)))
+    {
+      tree new_size = max_size (TYPE_SIZE (type), true);
+      c = tree_int_cst_compare (TYPE_SIZE (etype), new_size);
+      if (c < 0)
+	{
+	  expr = convert (maybe_pad_type (etype, new_size, 0, Empty,
+					  false, false, false, true),
+			  expr);
+	  expr = unchecked_convert (type, expr, notrunc_p);
 	}
       else
 	{

[-- Attachment #3: unchecked_convert1.ads --]
[-- Type: text/x-adasrc, Size: 432 bytes --]

-- { dg-do compile }
-- { dg-options "-gnatws" }

with Ada.Unchecked_Conversion;
with System;

package Unchecked_Convert1 is

  type Rec (D : Boolean := False) is record
    case D is
      when True => I : Integer;
      when False => null;
    end case;
  end record;

  function To_Rec is new Ada.Unchecked_Conversion (System.Address, Rec);

  function F (A : System.Address) return Rec is (To_Rec (A));

end Unchecked_Convert1;

[-- Attachment #4: unchecked_convert2.ads --]
[-- Type: text/x-adasrc, Size: 407 bytes --]

-- { dg-do compile }
-- { dg-options "-gnatws" }

with Ada.Unchecked_Conversion;

package Unchecked_Convert2 is

  type Address is access String;
  for Address'Size use Standard'Address_Size;

  type Rec is record
    A : Address;
  end record;

  function To_Integer is new Ada.Unchecked_Conversion (Address, Integer);

  function F (R : Rec) return Integer is (To_Integer (R.A));

end Unchecked_Convert2;