OSDN Git Service

* gigi.h (standard_datatypes): Add ADT_fdesc_type and ADT_null_fdesc.
[pf3gnuchains/gcc-fork.git] / gcc / ada / utils.c
index 77be01d..76f4aab 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2007, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2008, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -298,8 +298,8 @@ gnat_pushlevel ()
   if (free_block_chain)
     {
       newlevel->block = free_block_chain;
-      free_block_chain = TREE_CHAIN (free_block_chain);
-      TREE_CHAIN (newlevel->block) = NULL_TREE;
+      free_block_chain = BLOCK_CHAIN (free_block_chain);
+      BLOCK_CHAIN (newlevel->block) = NULL_TREE;
     }
   else
     newlevel->block = make_node (BLOCK);
@@ -365,12 +365,12 @@ gnat_poplevel ()
       BLOCK_SUBBLOCKS (level->chain->block)
        = chainon (BLOCK_SUBBLOCKS (block),
                   BLOCK_SUBBLOCKS (level->chain->block));
-      TREE_CHAIN (block) = free_block_chain;
+      BLOCK_CHAIN (block) = free_block_chain;
       free_block_chain = block;
     }
   else
     {
-      TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
+      BLOCK_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
       BLOCK_SUBBLOCKS (level->chain->block) = block;
       TREE_USED (block) = 1;
       set_block_for_group (block);
@@ -382,17 +382,6 @@ gnat_poplevel ()
   free_binding_level = level;
 }
 
-/* Insert BLOCK at the end of the list of subblocks of the
-   current binding level.  This is used when a BIND_EXPR is expanded,
-   to handle the BLOCK node inside the BIND_EXPR.  */
-
-void
-insert_block (tree block)
-{
-  TREE_USED (block) = 1;
-  TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block);
-  BLOCK_SUBBLOCKS (current_binding_level->block) = block;
-}
 \f
 /* Records a ..._DECL node DECL as belonging to the current lexical scope
    and uses GNAT_NODE for location information and propagating flags.  */
@@ -458,7 +447,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
       tree t = TREE_TYPE (decl);
 
       if (!TYPE_NAME (t) || TREE_CODE (TYPE_NAME (t)) == IDENTIFIER_NODE)
-       TYPE_NAME (t) = decl;
+       ;
       else if (TYPE_FAT_POINTER_P (t))
        {
          tree tt = build_variant_type_copy (t);
@@ -466,9 +455,18 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
          TREE_USED (tt) = TREE_USED (t);
          TREE_TYPE (decl) = tt;
          DECL_ORIGINAL_TYPE (decl) = t;
+         t = NULL_TREE;
        }
       else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl))
-       TYPE_NAME (t) = decl;
+       ;
+      else
+       t = NULL_TREE;
+
+      /* Propagate the name to all the variants.  This is needed for
+        the type qualifiers machinery to work properly.  */
+      if (t)
+       for (t = TYPE_MAIN_VARIANT (t); t; t = TYPE_NEXT_VARIANT (t))
+         TYPE_NAME (t) = decl;
     }
 }
 \f
@@ -495,16 +493,6 @@ gnat_init_decl_processing (void)
   set_sizetype (size_type_node);
   build_common_tree_nodes_2 (0);
 
-  /* Give names and make TYPE_DECLs for common types.  */
-  create_type_decl (get_identifier (SIZE_TYPE), sizetype,
-                   NULL, false, true, Empty);
-  create_type_decl (get_identifier ("integer"), integer_type_node,
-                   NULL, false, true, Empty);
-  create_type_decl (get_identifier ("unsigned char"), char_type_node,
-                   NULL, false, true, Empty);
-  create_type_decl (get_identifier ("long integer"), long_integer_type_node,
-                   NULL, false, true, Empty);
-
   ptr_void_type_node = build_pointer_type (void_type_node);
 
   gnat_install_builtins ();
@@ -560,6 +548,27 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
   void_ftype = build_function_type (void_type_node, NULL_TREE);
   ptr_void_ftype = build_pointer_type (void_ftype);
 
+  /* Build the special descriptor type and its null node if needed.  */
+  if (TARGET_VTABLE_USES_DESCRIPTORS)
+    {
+      tree field_list = NULL_TREE, null_list = NULL_TREE;
+      int j;
+
+      fdesc_type_node = make_node (RECORD_TYPE);
+
+      for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
+       {
+         tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
+                                         fdesc_type_node, 0, 0, 0, 1);
+         TREE_CHAIN (field) = field_list;
+         field_list = field;
+         null_list = tree_cons (field, null_pointer_node, null_list);
+       }
+
+      finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
+      null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+    }
+
   /* Now declare runtime functions. */
   endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
 
@@ -757,16 +766,19 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
                    bool do_not_finalize)
 {
   enum tree_code code = TREE_CODE (record_type);
+  tree name = TYPE_NAME (record_type);
   tree ada_size = bitsize_zero_node;
   tree size = bitsize_zero_node;
-  bool var_size = false;
   bool had_size = TYPE_SIZE (record_type) != 0;
   bool had_size_unit = TYPE_SIZE_UNIT (record_type) != 0;
+  bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
+  if (name && TREE_CODE (name) == TYPE_DECL)
+    name = DECL_NAME (name);
+
   TYPE_FIELDS (record_type) = fieldlist;
-  TYPE_STUB_DECL (record_type)
-    = build_decl (TYPE_DECL, TYPE_NAME (record_type), record_type);
+  TYPE_STUB_DECL (record_type) = build_decl (TYPE_DECL, name, record_type);
 
   /* We don't need both the typedef name and the record name output in
      the debugging information, since they are the same.  */
@@ -812,33 +824,55 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
 
   for (field = fieldlist; field; field = TREE_CHAIN (field))
     {
-      tree pos = bit_position (field);
-
       tree type = TREE_TYPE (field);
+      tree pos = bit_position (field);
       tree this_size = DECL_SIZE (field);
-      tree this_ada_size = DECL_SIZE (field);
+      tree this_ada_size;
 
-      /* We need to make an XVE/XVU record if any field has variable size,
-        whether or not the record does.  For example, if we have a union,
-        it may be that all fields, rounded up to the alignment, have the
-        same size, in which case we'll use that size.  But the debug
-        output routines (except Dwarf2) won't be able to output the fields,
-        so we need to make the special record.  */
-      if (TREE_CODE (this_size) != INTEGER_CST)
-       var_size = true;
-
-      if ((TREE_CODE (type) == RECORD_TYPE || TREE_CODE (type) == UNION_TYPE
-         || TREE_CODE (type) == QUAL_UNION_TYPE)
+      if ((TREE_CODE (type) == RECORD_TYPE
+          || TREE_CODE (type) == UNION_TYPE
+          || TREE_CODE (type) == QUAL_UNION_TYPE)
          && !TYPE_IS_FAT_POINTER_P (type)
          && !TYPE_CONTAINS_TEMPLATE_P (type)
          && TYPE_ADA_SIZE (type))
        this_ada_size = TYPE_ADA_SIZE (type);
+      else
+       this_ada_size = this_size;
 
       /* Clear DECL_BIT_FIELD for the cases layout_decl does not handle.  */
-      if (DECL_BIT_FIELD (field) && !STRICT_ALIGNMENT
-         && value_factor_p (pos, BITS_PER_UNIT)
+      if (DECL_BIT_FIELD (field)
          && operand_equal_p (this_size, TYPE_SIZE (type), 0))
-       DECL_BIT_FIELD (field) = 0;
+       {
+         unsigned int align = TYPE_ALIGN (type);
+
+         /* In the general case, type alignment is required.  */
+         if (value_factor_p (pos, align))
+           {
+             /* The enclosing record type must be sufficiently aligned.
+                Otherwise, if no alignment was specified for it and it
+                has been laid out already, bump its alignment to the
+                desired one if this is compatible with its size.  */
+             if (TYPE_ALIGN (record_type) >= align)
+               {
+                 DECL_ALIGN (field) = MAX (DECL_ALIGN (field), align);
+                 DECL_BIT_FIELD (field) = 0;
+               }
+             else if (!had_align
+                      && rep_level == 0
+                      && value_factor_p (TYPE_SIZE (record_type), align))
+               {
+                 TYPE_ALIGN (record_type) = align;
+                 DECL_ALIGN (field) = MAX (DECL_ALIGN (field), align);
+                 DECL_BIT_FIELD (field) = 0;
+               }
+           }
+
+         /* In the non-strict alignment case, only byte alignment is.  */
+         if (!STRICT_ALIGNMENT
+             && DECL_BIT_FIELD (field)
+             && value_factor_p (pos, BITS_PER_UNIT))
+           DECL_BIT_FIELD (field) = 0;
+       }
 
       /* If we still have DECL_BIT_FIELD set at this point, we know the field
         is technically not addressable.  Except that it can actually be
@@ -847,7 +881,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
       DECL_NONADDRESSABLE_P (field)
        |= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
 
-      if ((rep_level > 0) && !DECL_BIT_FIELD (field))
+      /* A type must be as aligned as its most aligned field that is not
+        a bit-field.  But this is already enforced by layout_type.  */
+      if (rep_level > 0 && !DECL_BIT_FIELD (field))
        TYPE_ALIGN (record_type)
          = MAX (TYPE_ALIGN (record_type), DECL_ALIGN (field));
 
@@ -1240,17 +1276,15 @@ split_plus (tree in, tree *pvar)
    otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
    PARM_DECL nodes that are the subprogram arguments.  CICO_LIST is the
    copy-in/copy-out list to be stored into TYPE_CICO_LIST.
-   RETURNS_UNCONSTRAINED is nonzero if the function returns an unconstrained
-   object.  RETURNS_BY_REF is nonzero if the function returns by reference.
-   RETURNS_WITH_DSP is nonzero if the function is to return with a
-   depressed stack pointer.  RETURNS_BY_TARGET_PTR is true if the function
-   is to be passed (as its first parameter) the address of the place to copy
-   its result.  */
+   RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
+   object.  RETURNS_BY_REF is true if the function returns by reference.
+   RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
+   first parameter) the address of the place to copy its result.  */
 
 tree
 create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
                      bool returns_unconstrained, bool returns_by_ref,
-                     bool returns_with_dsp, bool returns_by_target_ptr)
+                     bool returns_by_target_ptr)
 {
   /* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
      the subprogram formal parameters. This list is generated by traversing the
@@ -1287,7 +1321,6 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
 
   TYPE_CI_CO_LIST (type) = cico_list;
   TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
-  TYPE_RETURNS_STACK_DEPRESSED (type) = returns_with_dsp;
   TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
   TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
   return type;
@@ -1474,7 +1507,10 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
     TREE_ADDRESSABLE (var_decl) = 1;
 
   if (TREE_CODE (var_decl) != CONST_DECL)
-    rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
+    {
+      if (global_bindings_p ())
+       rest_of_decl_compilation (var_decl, true, 0);
+    }
   else
     expand_decl (var_decl);
 
@@ -1513,6 +1549,33 @@ create_true_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
                            attr_list, gnat_node);
 }
 \f
+/* Return true if TYPE, an aggregate type, contains (or is) an array.  */
+
+static bool
+aggregate_type_contains_array_p (tree type)
+{
+  switch (TREE_CODE (type))
+    {
+    case RECORD_TYPE:
+    case UNION_TYPE:
+    case QUAL_UNION_TYPE:
+      {
+       tree field;
+       for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+         if (AGGREGATE_TYPE_P (TREE_TYPE (field))
+             && aggregate_type_contains_array_p (TREE_TYPE (field)))
+           return true;
+       return false;
+      }
+
+    case ARRAY_TYPE:
+      return true;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
 /* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
    type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
    this field is in a record type with a "pragma pack".  If SIZE is nonzero
@@ -1531,8 +1594,15 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
   TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
 
   /* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
-     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.  */
-  if (packed && TYPE_MODE (field_type) == BLKmode)
+     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
+     Likewise for an aggregate without specified position that contains an
+     array, because in this case slices of variable length of this array
+     must be handled by GCC and variable-sized objects need to be aligned
+     to at least a byte boundary.  */
+  if (packed && (TYPE_MODE (field_type) == BLKmode
+                || (!pos
+                    && AGGREGATE_TYPE_P (field_type)
+                    && aggregate_type_contains_array_p (field_type))))
     DECL_ALIGN (field_decl) = BITS_PER_UNIT;
 
   /* If a size is specified, use it.  Otherwise, if the record type is packed
@@ -1588,11 +1658,24 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
     }
 
   DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
-  DECL_ALIGN (field_decl)
-    = MAX (DECL_ALIGN (field_decl),
-          DECL_BIT_FIELD (field_decl) ? 1
-          : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT
-          : TYPE_ALIGN (field_type));
+
+  /* Bump the alignment if need be, either for bitfield/packing purposes or
+     to satisfy the type requirements if no such consideration applies.  When
+     we get the alignment from the type, indicate if this is from an explicit
+     user request, which prevents stor-layout from lowering it later on.  */
+  {
+    int bit_align
+      = (DECL_BIT_FIELD (field_decl) ? 1
+        : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT : 0);
+
+    if (bit_align > DECL_ALIGN (field_decl))
+      DECL_ALIGN (field_decl) = bit_align;
+    else if (!bit_align && TYPE_ALIGN (field_type) > DECL_ALIGN (field_decl))
+      {
+       DECL_ALIGN (field_decl) = TYPE_ALIGN (field_type);
+       DECL_USER_ALIGN (field_decl) = TYPE_USER_ALIGN (field_type);
+      }
+  }
 
   if (pos)
     {
@@ -1640,7 +1723,7 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
 \f
 /* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
    PARAM_TYPE is its type.  READONLY is true if the parameter is
-   readonly (either an IN parameter or an address of a pass-by-ref
+   readonly (either an In parameter or an address of a pass-by-ref
    parameter). */
 
 tree
@@ -1767,7 +1850,7 @@ value_factor_p (tree value, HOST_WIDE_INT factor)
     return (value_factor_p (TREE_OPERAND (value, 0), factor)
             || value_factor_p (TREE_OPERAND (value, 1), factor));
 
-  return 0;
+  return false;
 }
 
 /* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true
@@ -1865,18 +1948,18 @@ create_subprog_decl (tree subprog_name, tree asm_name,
   DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
   DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
 
-   /* TREE_ADDRESSABLE is set on the result type to request the use of the
-      target by-reference return mechanism.  This is not supported all the
-      way down to RTL expansion with GCC 4, which ICEs on temporary creation
-      attempts with such a type and expects DECL_BY_REFERENCE to be set on
-      the RESULT_DECL instead - see gnat_genericize for more details.  */
-   if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
-     {
-       tree result_decl = DECL_RESULT (subprog_decl);
+  /* TREE_ADDRESSABLE is set on the result type to request the use of the
+     target by-reference return mechanism.  This is not supported all the
+     way down to RTL expansion with GCC 4, which ICEs on temporary creation
+     attempts with such a type and expects DECL_BY_REFERENCE to be set on
+     the RESULT_DECL instead - see gnat_genericize for more details.  */
+  if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
+    {
+      tree result_decl = DECL_RESULT (subprog_decl);
 
-       TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
-       DECL_BY_REFERENCE (result_decl) = 1;
-     }
+      TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
+      DECL_BY_REFERENCE (result_decl) = 1;
+    }
 
   if (inline_flag)
     DECL_DECLARED_INLINE_P (subprog_decl) = 1;
@@ -2036,7 +2119,7 @@ gnat_genericize (tree fndecl)
      type, and the gimplifier ICEs on such attempts.  Second, the middle-end
      now relies on a different attribute for such cases (DECL_BY_REFERENCE on
      RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to
-     be explicitely accounted for by the front-end in the function body.
+     be explicitly accounted for by the front-end in the function body.
 
      We achieve the complete transformation in two steps:
 
@@ -2054,7 +2137,7 @@ gnat_genericize (tree fndecl)
      strategy, which escapes the gimplifier temporary creation issues by
      creating it's own temporaries using TARGET_EXPR nodes.  Our way relies
      on simple specific support code in aggregate_value_p to look at the
-     target function result decl explicitely.  */
+     target function result decl explicitly.  */
 
   struct pointer_set_t *p_set;
   tree decl_result = DECL_RESULT (fndecl);
@@ -2062,7 +2145,7 @@ gnat_genericize (tree fndecl)
   if (!DECL_BY_REFERENCE (decl_result))
     return;
 
-  /* Make the DECL_RESULT explicitely by-reference and adjust all the
+  /* Make the DECL_RESULT explicitly by-reference and adjust all the
      occurrences in the function body using the common tree-walking facility.
      We want to see every occurrence of the result decl to adjust the
      referencing tree, so need to use our own pointer set to control which
@@ -2316,6 +2399,42 @@ gnat_signed_type (tree type_node)
   return type;
 }
 
+/* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
+   transparently converted to each other.  */
+
+int
+gnat_types_compatible_p (tree t1, tree t2)
+{
+  enum tree_code code;
+
+  /* This is the default criterion.  */
+  if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
+    return 1;
+
+  /* We only check structural equivalence here.  */
+  if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
+    return 0;
+
+  /* Array types are also compatible if they are constrained and have
+     the same component type and the same domain.  */
+  if (code == ARRAY_TYPE
+      && TREE_TYPE (t1) == TREE_TYPE (t2)
+      && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (t1)),
+                            TYPE_MIN_VALUE (TYPE_DOMAIN (t2)))
+      && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (t1)),
+                            TYPE_MAX_VALUE (TYPE_DOMAIN (t2))))
+    return 1;
+
+  /* Padding record types are also compatible if they pad the same
+     type and have the same constant size.  */
+  if (code == RECORD_TYPE
+      && TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2)
+      && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
+      && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
+    return 1;
+
+  return 0;
+}
 \f
 /* EXP is an expression for the size of an object.  If this size contains
    discriminant references, replace them with the maximum (if MAX_P) or
@@ -2453,9 +2572,9 @@ build_template (tree template_type, tree array_type, tree expr)
   tree bound_list = NULL_TREE;
   tree field;
 
-  if (TREE_CODE (array_type) == RECORD_TYPE
-      && (TYPE_IS_PADDING_P (array_type)
-         || TYPE_JUSTIFIED_MODULAR_P (array_type)))
+  while (TREE_CODE (array_type) == RECORD_TYPE
+        && (TYPE_IS_PADDING_P (array_type)
+            || TYPE_JUSTIFIED_MODULAR_P (array_type)))
     array_type = TREE_TYPE (TYPE_FIELDS (array_type));
 
   if (TREE_CODE (array_type) == ARRAY_TYPE
@@ -2979,9 +3098,9 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
   /* Invoke the internal subprogram.  */
   gnu_subprog_addr = build1 (ADDR_EXPR, build_pointer_type (gnu_subprog_type),
                             gnu_subprog);
-  gnu_subprog_call = build3 (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
-                            gnu_subprog_addr, nreverse (gnu_param_list),
-                            NULL_TREE);
+  gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
+                                     gnu_subprog_addr,
+                                     nreverse (gnu_param_list));
 
   /* Propagate the return value, if any.  */
   if (VOID_TYPE_P (TREE_TYPE (gnu_subprog_type)))
@@ -2993,7 +3112,7 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
 
   gnat_poplevel ();
 
-  allocate_struct_function (gnu_stub_decl);
+  allocate_struct_function (gnu_stub_decl, false);
   end_subprog_body (gnu_body);
 }
 \f
@@ -3306,15 +3425,15 @@ convert (tree type, tree expr)
   /* If both input and output have padding and are of variable size, do this
      as an unchecked conversion.  Likewise if one is a mere variant of the
      other, so we avoid a pointless unpad/repad sequence.  */
-  else if (ecode == RECORD_TYPE && code == RECORD_TYPE
+  else if (code == RECORD_TYPE && ecode == RECORD_TYPE
           && TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
           && (!TREE_CONSTANT (TYPE_SIZE (type))
               || !TREE_CONSTANT (TYPE_SIZE (etype))
-              || TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)))
+              || gnat_types_compatible_p (type, etype)))
     ;
 
-  /* If the output type has padding, make a constructor to build the
-     record.  */
+  /* If the output type has padding, convert to the inner type and
+     make a constructor to build the record.  */
   else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
     {
       /* If we previously converted from another type and our type is
@@ -3325,12 +3444,15 @@ convert (tree type, tree expr)
        expr = TREE_OPERAND (expr, 0);
 
       /* If we are just removing the padding from expr, convert the original
-        object if we have variable size.  That will avoid the need
-        for some variable-size temporaries.  */
+        object if we have variable size in order to avoid the need for some
+        variable-size temporaries.  Likewise if the padding is a mere variant
+        of the other, so we avoid a pointless unpad/repad sequence.  */
       if (TREE_CODE (expr) == COMPONENT_REF
          && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
          && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
-         && !TREE_CONSTANT (TYPE_SIZE (type)))
+         && (!TREE_CONSTANT (TYPE_SIZE (type))
+             || gnat_types_compatible_p (type,
+                                         TREE_TYPE (TREE_OPERAND (expr, 0)))))
        return convert (type, TREE_OPERAND (expr, 0));
 
       /* If the result type is a padded type with a self-referentially-sized
@@ -3444,14 +3566,9 @@ convert (tree type, tree expr)
       break;
 
     case CONSTRUCTOR:
-      /* If we are converting a CONSTRUCTOR to another constrained array type
-        with the same domain, just make a new one in the proper type.  */
-      if (code == ecode && code == ARRAY_TYPE
-         && TREE_TYPE (type) == TREE_TYPE (etype)
-         && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
-                                TYPE_MIN_VALUE (TYPE_DOMAIN (etype)))
-         && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
-                                TYPE_MAX_VALUE (TYPE_DOMAIN (etype))))
+      /* If we are converting a CONSTRUCTOR to a mere variant type, just make
+        a new one in the proper type.  */
+      if (gnat_types_compatible_p (type, etype))
        {
          expr = copy_node (expr);
          TREE_TYPE (expr) = type;
@@ -3477,7 +3594,6 @@ convert (tree type, tree expr)
           the inner operand to the output type is fine in most cases, it
           might expose unexpected input/output type mismatches in special
           circumstances so we avoid such recursive calls when we can.  */
-
        tree op0 = TREE_OPERAND (expr, 0);
 
        /* If we are converting back to the original type, we can just
@@ -3487,13 +3603,13 @@ convert (tree type, tree expr)
          return op0;
 
        /* Otherwise, if we're converting between two aggregate types, we
-          might be allowed to substitute the VIEW_CONVERT target type in
-          place or to just convert the inner expression.  */
+          might be allowed to substitute the VIEW_CONVERT_EXPR target type
+          in place or to just convert the inner expression.  */
        if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
          {
-           /* If we are converting between type variants, we can just
-              substitute the VIEW_CONVERT in place.  */
-           if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+           /* If we are converting between mere variants, we can just
+              substitute the VIEW_CONVERT_EXPR in place.  */
+           if (gnat_types_compatible_p (type, etype))
              return build1 (VIEW_CONVERT_EXPR, type, op0);
 
            /* Otherwise, we may just bypass the input view conversion unless
@@ -3532,10 +3648,10 @@ convert (tree type, tree expr)
   if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
     return convert_to_fat_pointer (type, expr);
 
-  /* If we're converting between two aggregate types that have the same main
-     variant, just make a VIEW_CONVER_EXPR.  */
+  /* If we're converting between two aggregate types that are mere
+     variants, just make a VIEW_CONVERT_EXPR.  */
   else if (AGGREGATE_TYPE_P (type)
-          && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+          && gnat_types_compatible_p (type, etype))
     return build1 (VIEW_CONVERT_EXPR, type, expr);
 
   /* In all other cases of related types, make a NOP_EXPR.  */
@@ -3833,8 +3949,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
       expr = convert (rtype, expr);
       if (type != rtype)
-       expr = build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
-                      type, expr);
+       expr = fold_build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
+                           type, expr);
     }
 
   /* If we are converting TO an integral type whose precision is not the
@@ -3885,13 +4001,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   else
     {
       expr = maybe_unconstrained_array (expr);
-
-      /* There's no point in doing two unchecked conversions in a row.  */
-      if (TREE_CODE (expr) == VIEW_CONVERT_EXPR)
-       expr = TREE_OPERAND (expr, 0);
-
       etype = TREE_TYPE (expr);
-      expr = build1 (VIEW_CONVERT_EXPR, type, expr);
+      expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
     }
 
   /* If the result is an integral type whose size is not equal to