re PR target/65697 (__atomic memory barriers not strong enough for __sync builtins)
[gcc.git] / gcc / tree.c
index 119bcbe18464673b5f7ed850c8217b20fe98b2ad..6628a387f621d767eecec19f1ce3130258e4b4f9 100644 (file)
@@ -24,23 +24,16 @@ along with GCC; see the file COPYING3.  If not see
    tables index by tree code that describe how to take apart
    nodes of that code.
 
-   It is intended to be language-independent, but occasionally
-   calls language-dependent routines defined (for C) in typecheck.c.  */
+   It is intended to be language-independent but can occasionally
+   calls language-dependent routines.  */
 
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
 #include "tm.h"
 #include "flags.h"
-#include "hash-set.h"
-#include "machmode.h"
-#include "vec.h"
-#include "double-int.h"
-#include "input.h"
 #include "alias.h"
 #include "symtab.h"
-#include "wide-int.h"
-#include "inchash.h"
 #include "tree.h"
 #include "fold-const.h"
 #include "stor-layout.h"
@@ -48,7 +41,6 @@ along with GCC; see the file COPYING3.  If not see
 #include "attribs.h"
 #include "varasm.h"
 #include "tm_p.h"
-#include "hashtab.h"
 #include "hard-reg-set.h"
 #include "function.h"
 #include "obstack.h"
@@ -68,22 +60,15 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree-ssa-alias.h"
 #include "internal-fn.h"
 #include "gimple-expr.h"
-#include "is-a.h"
 #include "gimple.h"
 #include "gimple-iterator.h"
 #include "gimplify.h"
 #include "gimple-ssa.h"
-#include "hash-map.h"
-#include "plugin-api.h"
-#include "ipa-ref.h"
 #include "cgraph.h"
 #include "tree-phinodes.h"
 #include "stringpool.h"
 #include "tree-ssanames.h"
 #include "rtl.h"
-#include "statistics.h"
-#include "real.h"
-#include "fixed-value.h"
 #include "insn-config.h"
 #include "expmed.h"
 #include "dojump.h"
@@ -209,21 +194,15 @@ struct GTY((for_user)) type_hash {
 /* Initial size of the hash table (rounded to next prime).  */
 #define TYPE_HASH_INITIAL_SIZE 1000
 
-struct type_cache_hasher : ggc_cache_hasher<type_hash *>
+struct type_cache_hasher : ggc_cache_ptr_hash<type_hash>
 {
   static hashval_t hash (type_hash *t) { return t->hash; }
   static bool equal (type_hash *a, type_hash *b);
 
-  static void
-  handle_cache_entry (type_hash *&t)
+  static int
+  keep_cache_entry (type_hash *&t)
   {
-    extern void gt_ggc_mx (type_hash *&);
-    if (t == HTAB_DELETED_ENTRY || t == HTAB_EMPTY_ENTRY)
-      return;
-    else if (ggc_marked_p (t->type))
-      gt_ggc_mx (t);
-    else
-      t = static_cast<type_hash *> (HTAB_DELETED_ENTRY);
+    return ggc_marked_p (t->type);
   }
 };
 
@@ -239,7 +218,7 @@ static GTY ((cache)) hash_table<type_cache_hasher> *type_hash_table;
 /* Hash table and temporary node for larger integer const values.  */
 static GTY (()) tree int_cst_node;
 
-struct int_cst_hasher : ggc_cache_hasher<tree>
+struct int_cst_hasher : ggc_cache_ptr_hash<tree_node>
 {
   static hashval_t hash (tree t);
   static bool equal (tree x, tree y);
@@ -255,7 +234,7 @@ static GTY ((cache)) hash_table<int_cst_hasher> *int_cst_hash_table;
 static GTY (()) tree cl_optimization_node;
 static GTY (()) tree cl_target_option_node;
 
-struct cl_option_hasher : ggc_cache_hasher<tree>
+struct cl_option_hasher : ggc_cache_ptr_hash<tree_node>
 {
   static hashval_t hash (tree t);
   static bool equal (tree x, tree y);
@@ -272,7 +251,7 @@ static GTY ((cache))
 static GTY ((cache))
      hash_table<tree_decl_map_cache_hasher> *value_expr_for_decl;
 
-     struct tree_vec_map_cache_hasher : ggc_cache_hasher<tree_vec_map *>
+struct tree_vec_map_cache_hasher : ggc_cache_ptr_hash<tree_vec_map>
 {
   static hashval_t hash (tree_vec_map *m) { return DECL_UID (m->base.from); }
 
@@ -282,16 +261,10 @@ static GTY ((cache))
     return a->base.from == b->base.from;
   }
 
-  static void
-  handle_cache_entry (tree_vec_map *&m)
+  static int
+  keep_cache_entry (tree_vec_map *&m)
   {
-    extern void gt_ggc_mx (tree_vec_map *&);
-    if (m == HTAB_EMPTY_ENTRY || m == HTAB_DELETED_ENTRY)
-      return;
-    else if (ggc_marked_p (m->base.from))
-      gt_ggc_mx (m);
-    else
-      m = static_cast<tree_vec_map *> (HTAB_DELETED_ENTRY);
+    return ggc_marked_p (m->base.from);
   }
 };
 
@@ -1107,6 +1080,24 @@ make_node_stat (enum tree_code code MEM_STAT_DECL)
        }
       break;
 
+    case tcc_exceptional:
+      switch (code)
+        {
+       case TARGET_OPTION_NODE:
+         TREE_TARGET_OPTION(t)
+                           = ggc_cleared_alloc<struct cl_target_option> ();
+         break;
+
+       case OPTIMIZATION_NODE:
+         TREE_OPTIMIZATION (t)
+                           = ggc_cleared_alloc<struct cl_optimization> ();
+         break;
+
+       default:
+         break;
+       }
+      break;
+
     default:
       /* Other classes need no special treatment.  */
       break;
@@ -1188,6 +1179,18 @@ copy_node_stat (tree node MEM_STAT_DECL)
          TYPE_CACHED_VALUES (t) = NULL_TREE;
        }
     }
+    else if (code == TARGET_OPTION_NODE)
+      {
+       TREE_TARGET_OPTION (t) = ggc_alloc<struct cl_target_option>();
+       memcpy (TREE_TARGET_OPTION (t), TREE_TARGET_OPTION (node),
+               sizeof (struct cl_target_option));
+      }
+    else if (code == OPTIMIZATION_NODE)
+      {
+       TREE_OPTIMIZATION (t) = ggc_alloc<struct cl_optimization>();
+       memcpy (TREE_OPTIMIZATION (t), TREE_OPTIMIZATION (node),
+               sizeof (struct cl_optimization));
+      }
 
   return t;
 }
@@ -1663,7 +1666,7 @@ cst_and_fits_in_hwi (const_tree x)
   return TREE_INT_CST_NUNITS (x) == 1;
 }
 
-/* Build a newly constructed TREE_VEC node of length LEN.  */
+/* Build a newly constructed VECTOR_CST node of length LEN.  */
 
 tree
 make_vector_stat (unsigned len MEM_STAT_DECL)
@@ -4871,9 +4874,53 @@ simple_cst_list_equal (const_tree l1, const_tree l2)
   return l1 == l2;
 }
 
+/* Compare two identifier nodes representing attributes.  Either one may
+   be in wrapped __ATTR__ form.  Return true if they are the same, false
+   otherwise.  */
+
+static bool
+cmp_attrib_identifiers (const_tree attr1, const_tree attr2)
+{
+  /* Make sure we're dealing with IDENTIFIER_NODEs.  */
+  gcc_checking_assert (TREE_CODE (attr1) == IDENTIFIER_NODE
+                      && TREE_CODE (attr2) == IDENTIFIER_NODE);
+
+  /* Identifiers can be compared directly for equality.  */
+  if (attr1 == attr2)
+    return true;
+
+  /* If they are not equal, they may still be one in the form
+     'text' while the other one is in the form '__text__'.  TODO:
+     If we were storing attributes in normalized 'text' form, then
+     this could all go away and we could take full advantage of
+     the fact that we're comparing identifiers. :-)  */
+  const size_t attr1_len = IDENTIFIER_LENGTH (attr1);
+  const size_t attr2_len = IDENTIFIER_LENGTH (attr2);
+
+  if (attr2_len == attr1_len + 4)
+    {
+      const char *p = IDENTIFIER_POINTER (attr2);
+      const char *q = IDENTIFIER_POINTER (attr1);
+      if (p[0] == '_' && p[1] == '_'
+         && p[attr2_len - 2] == '_' && p[attr2_len - 1] == '_'
+         && strncmp (q, p + 2, attr1_len) == 0)
+       return true;;
+    }
+  else if (attr2_len + 4 == attr1_len)
+    {
+      const char *p = IDENTIFIER_POINTER (attr2);
+      const char *q = IDENTIFIER_POINTER (attr1);
+      if (q[0] == '_' && q[1] == '_'
+         && q[attr1_len - 2] == '_' && q[attr1_len - 1] == '_'
+         && strncmp (q + 2, p, attr2_len) == 0)
+       return true;
+    }
+
+  return false;
+}
+
 /* Compare two attributes for their value identity.  Return true if the
-   attribute values are known to be equal; otherwise return false.
-*/
+   attribute values are known to be equal; otherwise return false.  */
 
 bool
 attribute_value_equal (const_tree attr1, const_tree attr2)
@@ -4883,10 +4930,25 @@ attribute_value_equal (const_tree attr1, const_tree attr2)
 
   if (TREE_VALUE (attr1) != NULL_TREE
       && TREE_CODE (TREE_VALUE (attr1)) == TREE_LIST
-      && TREE_VALUE (attr2) != NULL
+      && TREE_VALUE (attr2) != NULL_TREE
       && TREE_CODE (TREE_VALUE (attr2)) == TREE_LIST)
-    return (simple_cst_list_equal (TREE_VALUE (attr1),
-                                  TREE_VALUE (attr2)) == 1);
+    {
+      /* Handle attribute format.  */
+      if (is_attribute_p ("format", TREE_PURPOSE (attr1)))
+       {
+         attr1 = TREE_VALUE (attr1);
+         attr2 = TREE_VALUE (attr2);
+         /* Compare the archetypes (printf/scanf/strftime/...).  */
+         if (!cmp_attrib_identifiers (TREE_VALUE (attr1),
+                                      TREE_VALUE (attr2)))
+           return false;
+         /* Archetypes are the same.  Compare the rest.  */
+         return (simple_cst_list_equal (TREE_CHAIN (attr1),
+                                        TREE_CHAIN (attr2)) == 1);
+       }
+      return (simple_cst_list_equal (TREE_VALUE (attr1),
+                                    TREE_VALUE (attr2)) == 1);
+    }
 
   if ((flag_openmp || flag_openmp_simd)
       && TREE_VALUE (attr1) && TREE_VALUE (attr2)
@@ -6037,38 +6099,10 @@ lookup_ident_attribute (tree attr_identifier, tree list)
       gcc_checking_assert (TREE_CODE (get_attribute_name (list))
                           == IDENTIFIER_NODE);
 
-      /* Identifiers can be compared directly for equality.  */
-      if (attr_identifier == get_attribute_name (list))
+      if (cmp_attrib_identifiers (attr_identifier,
+                                 get_attribute_name (list)))
+       /* Found it.  */
        break;
-
-      /* If they are not equal, they may still be one in the form
-        'text' while the other one is in the form '__text__'.  TODO:
-        If we were storing attributes in normalized 'text' form, then
-        this could all go away and we could take full advantage of
-        the fact that we're comparing identifiers. :-)  */
-      {
-       size_t attr_len = IDENTIFIER_LENGTH (attr_identifier);
-       size_t ident_len = IDENTIFIER_LENGTH (get_attribute_name (list));
-
-       if (ident_len == attr_len + 4)
-         {
-           const char *p = IDENTIFIER_POINTER (get_attribute_name (list));
-           const char *q = IDENTIFIER_POINTER (attr_identifier);
-           if (p[0] == '_' && p[1] == '_'
-               && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
-               && strncmp (q, p + 2, attr_len) == 0)
-             break;
-         }
-       else if (ident_len + 4 == attr_len)
-         {
-           const char *p = IDENTIFIER_POINTER (get_attribute_name (list));
-           const char *q = IDENTIFIER_POINTER (attr_identifier);
-           if (q[0] == '_' && q[1] == '_'
-               && q[attr_len - 2] == '_' && q[attr_len - 1] == '_'
-               && strncmp (q + 2, p, ident_len) == 0)
-             break;
-         }
-      }
       list = TREE_CHAIN (list);
     }
 
@@ -7719,6 +7753,7 @@ build_pointer_type_for_mode (tree to_type, machine_mode mode,
                             bool can_alias_all)
 {
   tree t;
+  bool could_alias = can_alias_all;
 
   if (to_type == error_mark_node)
     return error_mark_node;
@@ -7756,7 +7791,7 @@ build_pointer_type_for_mode (tree to_type, machine_mode mode,
 
   if (TYPE_STRUCTURAL_EQUALITY_P (to_type))
     SET_TYPE_STRUCTURAL_EQUALITY (t);
-  else if (TYPE_CANONICAL (to_type) != to_type)
+  else if (TYPE_CANONICAL (to_type) != to_type || could_alias)
     TYPE_CANONICAL (t)
       = build_pointer_type_for_mode (TYPE_CANONICAL (to_type),
                                     mode, false);
@@ -7786,6 +7821,7 @@ build_reference_type_for_mode (tree to_type, machine_mode mode,
                               bool can_alias_all)
 {
   tree t;
+  bool could_alias = can_alias_all;
 
   if (to_type == error_mark_node)
     return error_mark_node;
@@ -7823,7 +7859,7 @@ build_reference_type_for_mode (tree to_type, machine_mode mode,
 
   if (TYPE_STRUCTURAL_EQUALITY_P (to_type))
     SET_TYPE_STRUCTURAL_EQUALITY (t);
-  else if (TYPE_CANONICAL (to_type) != to_type)
+  else if (TYPE_CANONICAL (to_type) != to_type || could_alias)
     TYPE_CANONICAL (t)
       = build_reference_type_for_mode (TYPE_CANONICAL (to_type),
                                       mode, false);
@@ -9123,6 +9159,8 @@ get_callee_fndecl (const_tree call)
   return NULL_TREE;
 }
 
+#define TREE_MEM_USAGE_SPACES 40
+
 /* Print debugging information about tree nodes generated during the compile,
    and any language-specific information.  */
 
@@ -9133,8 +9171,8 @@ dump_tree_statistics (void)
     {
       int i;
       int total_nodes, total_bytes;
-      fprintf (stderr, "Kind                   Nodes      Bytes\n");
-      fprintf (stderr, "---------------------------------------\n");
+      fprintf (stderr, "\nKind                   Nodes      Bytes\n");
+      mem_usage::print_dash_line (TREE_MEM_USAGE_SPACES);
       total_nodes = total_bytes = 0;
       for (i = 0; i < (int) all_kinds; i++)
        {
@@ -9143,17 +9181,20 @@ dump_tree_statistics (void)
          total_nodes += tree_node_counts[i];
          total_bytes += tree_node_sizes[i];
        }
-      fprintf (stderr, "---------------------------------------\n");
+      mem_usage::print_dash_line (TREE_MEM_USAGE_SPACES);
       fprintf (stderr, "%-20s %7d %10d\n", "Total", total_nodes, total_bytes);
-      fprintf (stderr, "---------------------------------------\n");
+      mem_usage::print_dash_line (TREE_MEM_USAGE_SPACES);
       fprintf (stderr, "Code                   Nodes\n");
-      fprintf (stderr, "----------------------------\n");
+      mem_usage::print_dash_line (TREE_MEM_USAGE_SPACES);
       for (i = 0; i < (int) MAX_TREE_CODES; i++)
-       fprintf (stderr, "%-20s %7d\n", get_tree_code_name ((enum tree_code) i),
+       fprintf (stderr, "%-32s %7d\n", get_tree_code_name ((enum tree_code) i),
                  tree_code_counts[i]);
-      fprintf (stderr, "----------------------------\n");
+      mem_usage::print_dash_line (TREE_MEM_USAGE_SPACES);
+      fprintf (stderr, "\n");
       ssanames_print_statistics ();
+      fprintf (stderr, "\n");
       phinodes_print_statistics ();
+      fprintf (stderr, "\n");
     }
   else
     fprintf (stderr, "(No per-node statistics)\n");
@@ -9231,6 +9272,42 @@ clean_symbol_name (char *p)
       *p = '_';
 }
 
+/* For anonymous aggregate types, we need some sort of name to
+   hold on to.  In practice, this should not appear, but it should
+   not be harmful if it does.  */
+bool 
+anon_aggrname_p(const_tree id_node)
+{
+#ifndef NO_DOT_IN_LABEL
+ return (IDENTIFIER_POINTER (id_node)[0] == '.'
+        && IDENTIFIER_POINTER (id_node)[1] == '_');
+#else /* NO_DOT_IN_LABEL */
+#ifndef NO_DOLLAR_IN_LABEL
+  return (IDENTIFIER_POINTER (id_node)[0] == '$' \
+         && IDENTIFIER_POINTER (id_node)[1] == '_');
+#else /* NO_DOLLAR_IN_LABEL */
+#define ANON_AGGRNAME_PREFIX "__anon_"
+  return (!strncmp (IDENTIFIER_POINTER (id_node), ANON_AGGRNAME_PREFIX, 
+                   sizeof (ANON_AGGRNAME_PREFIX) - 1));
+#endif /* NO_DOLLAR_IN_LABEL */
+#endif /* NO_DOT_IN_LABEL */
+}
+
+/* Return a format for an anonymous aggregate name.  */
+const char *
+anon_aggrname_format()
+{
+#ifndef NO_DOT_IN_LABEL
+ return "._%d";
+#else /* NO_DOT_IN_LABEL */
+#ifndef NO_DOLLAR_IN_LABEL
+  return "$_%d";
+#else /* NO_DOLLAR_IN_LABEL */
+  return "__anon_%d";
+#endif /* NO_DOLLAR_IN_LABEL */
+#endif /* NO_DOT_IN_LABEL */
+}
+
 /* Generate a name for a special-purpose function.
    The generated name may need to be unique across the whole link.
    Changes to this function may also require corresponding changes to
@@ -12453,6 +12530,139 @@ get_base_address (tree t)
   return t;
 }
 
+/* Return a tree of sizetype representing the size, in bytes, of the element
+   of EXP, an ARRAY_REF or an ARRAY_RANGE_REF.  */
+
+tree
+array_ref_element_size (tree exp)
+{
+  tree aligned_size = TREE_OPERAND (exp, 3);
+  tree elmt_type = TREE_TYPE (TREE_TYPE (TREE_OPERAND (exp, 0)));
+  location_t loc = EXPR_LOCATION (exp);
+
+  /* If a size was specified in the ARRAY_REF, it's the size measured
+     in alignment units of the element type.  So multiply by that value.  */
+  if (aligned_size)
+    {
+      /* ??? tree_ssa_useless_type_conversion will eliminate casts to
+        sizetype from another type of the same width and signedness.  */
+      if (TREE_TYPE (aligned_size) != sizetype)
+       aligned_size = fold_convert_loc (loc, sizetype, aligned_size);
+      return size_binop_loc (loc, MULT_EXPR, aligned_size,
+                            size_int (TYPE_ALIGN_UNIT (elmt_type)));
+    }
+
+  /* Otherwise, take the size from that of the element type.  Substitute
+     any PLACEHOLDER_EXPR that we have.  */
+  else
+    return SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (elmt_type), exp);
+}
+
+/* Return a tree representing the lower bound of the array mentioned in
+   EXP, an ARRAY_REF or an ARRAY_RANGE_REF.  */
+
+tree
+array_ref_low_bound (tree exp)
+{
+  tree domain_type = TYPE_DOMAIN (TREE_TYPE (TREE_OPERAND (exp, 0)));
+
+  /* If a lower bound is specified in EXP, use it.  */
+  if (TREE_OPERAND (exp, 2))
+    return TREE_OPERAND (exp, 2);
+
+  /* Otherwise, if there is a domain type and it has a lower bound, use it,
+     substituting for a PLACEHOLDER_EXPR as needed.  */
+  if (domain_type && TYPE_MIN_VALUE (domain_type))
+    return SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_MIN_VALUE (domain_type), exp);
+
+  /* Otherwise, return a zero of the appropriate type.  */
+  return build_int_cst (TREE_TYPE (TREE_OPERAND (exp, 1)), 0);
+}
+
+/* Return a tree representing the upper bound of the array mentioned in
+   EXP, an ARRAY_REF or an ARRAY_RANGE_REF.  */
+
+tree
+array_ref_up_bound (tree exp)
+{
+  tree domain_type = TYPE_DOMAIN (TREE_TYPE (TREE_OPERAND (exp, 0)));
+
+  /* If there is a domain type and it has an upper bound, use it, substituting
+     for a PLACEHOLDER_EXPR as needed.  */
+  if (domain_type && TYPE_MAX_VALUE (domain_type))
+    return SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_MAX_VALUE (domain_type), exp);
+
+  /* Otherwise fail.  */
+  return NULL_TREE;
+}
+
+/* Returns true if REF is an array reference to an array at the end of
+   a structure.  If this is the case, the array may be allocated larger
+   than its upper bound implies.  */
+
+bool
+array_at_struct_end_p (tree ref)
+{
+  if (TREE_CODE (ref) != ARRAY_REF
+      && TREE_CODE (ref) != ARRAY_RANGE_REF)
+    return false;
+
+  while (handled_component_p (ref))
+    {
+      /* If the reference chain contains a component reference to a
+         non-union type and there follows another field the reference
+        is not at the end of a structure.  */
+      if (TREE_CODE (ref) == COMPONENT_REF
+         && TREE_CODE (TREE_TYPE (TREE_OPERAND (ref, 0))) == RECORD_TYPE)
+       {
+         tree nextf = DECL_CHAIN (TREE_OPERAND (ref, 1));
+         while (nextf && TREE_CODE (nextf) != FIELD_DECL)
+           nextf = DECL_CHAIN (nextf);
+         if (nextf)
+           return false;
+       }
+
+      ref = TREE_OPERAND (ref, 0);
+    }
+
+  /* If the reference is based on a declared entity, the size of the array
+     is constrained by its given domain.  */
+  if (DECL_P (ref))
+    return false;
+
+  return true;
+}
+
+/* Return a tree representing the offset, in bytes, of the field referenced
+   by EXP.  This does not include any offset in DECL_FIELD_BIT_OFFSET.  */
+
+tree
+component_ref_field_offset (tree exp)
+{
+  tree aligned_offset = TREE_OPERAND (exp, 2);
+  tree field = TREE_OPERAND (exp, 1);
+  location_t loc = EXPR_LOCATION (exp);
+
+  /* If an offset was specified in the COMPONENT_REF, it's the offset measured
+     in units of DECL_OFFSET_ALIGN / BITS_PER_UNIT.  So multiply by that
+     value.  */
+  if (aligned_offset)
+    {
+      /* ??? tree_ssa_useless_type_conversion will eliminate casts to
+        sizetype from another type of the same width and signedness.  */
+      if (TREE_TYPE (aligned_offset) != sizetype)
+       aligned_offset = fold_convert_loc (loc, sizetype, aligned_offset);
+      return size_binop_loc (loc, MULT_EXPR, aligned_offset,
+                            size_int (DECL_OFFSET_ALIGN (field)
+                                      / BITS_PER_UNIT));
+    }
+
+  /* Otherwise, take the offset from that of the field.  Substitute
+     any PLACEHOLDER_EXPR that we have.  */
+  else
+    return SUBSTITUTE_PLACEHOLDER_IN_EXPR (DECL_FIELD_OFFSET (field), exp);
+}
+
 /* Return the machine mode of T.  For vectors, returns the mode of the
    inner type.  The main use case is to feed the result to HONOR_NANS,
    avoiding the BLKmode that a direct TYPE_MODE (T) might return.  */
@@ -12548,7 +12758,6 @@ verify_type_variant (const_tree t, tree tv)
        }
     }
   verify_variant_match (TYPE_PRECISION);
-  verify_variant_match (TYPE_NO_FORCE_BLK);
   verify_variant_match (TYPE_NEEDS_CONSTRUCTING);
   if (RECORD_OR_UNION_TYPE_P (t))
     verify_variant_match (TYPE_TRANSPARENT_AGGR);
@@ -12685,6 +12894,17 @@ verify_type_variant (const_tree t, tree tv)
       debug_tree (TREE_TYPE (t));
       return false;
     }
+  if (type_with_alias_set_p (t)
+      && !gimple_canonical_types_compatible_p (t, tv, false))
+    {
+      error ("type is not compatible with its vairant");
+      debug_tree (tv);
+      error ("type variant's TREE_TYPE");
+      debug_tree (TREE_TYPE (tv));
+      error ("type's TREE_TYPE");
+      debug_tree (TREE_TYPE (t));
+      return false;
+    }
   return true;
 #undef verify_variant_match
 }
@@ -12709,7 +12929,13 @@ bool
 gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
                                     bool trust_type_canonical)
 {
-  /* Before starting to set up the SCC machinery handle simple cases.  */
+  /* Type variants should be same as the main variant.  When not doing sanity
+     checking to verify this fact, go to main variants and save some work.  */
+  if (trust_type_canonical)
+    {
+      t1 = TYPE_MAIN_VARIANT (t1);
+      t2 = TYPE_MAIN_VARIANT (t2);
+    }
 
   /* Check first for the obvious case of pointer identity.  */
   if (t1 == t2)
@@ -12743,7 +12969,8 @@ gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
     return TYPE_CANONICAL (t1) == TYPE_CANONICAL (t2);
 
   /* Can't be the same type if the types don't have the same code.  */
-  if (TREE_CODE (t1) != TREE_CODE (t2))
+  if (tree_code_for_canonical_type_merging (TREE_CODE (t1))
+      != tree_code_for_canonical_type_merging (TREE_CODE (t2)))
     return false;
 
   /* Qualifiers do not matter for canonical type comparison purposes.  */
@@ -12771,22 +12998,18 @@ gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
          || TYPE_UNSIGNED (t1) != TYPE_UNSIGNED (t2))
        return false;
 
-      if (TREE_CODE (t1) == INTEGER_TYPE
-         && TYPE_STRING_FLAG (t1) != TYPE_STRING_FLAG (t2))
-       return false;
+      /* Fortran's C_SIGNED_CHAR is !TYPE_STRING_FLAG but needs to be
+        interoperable with "signed char".  Unless all frontends are revisited
+        to agree on these types, we must ignore the flag completely.  */
 
-      /* For canonical type comparisons we do not want to build SCCs
-        so we cannot compare pointed-to types.  But we can, for now,
-        require the same pointed-to type kind and match what
-        useless_type_conversion_p would do.  */
+      /* Fortran standard define C_PTR type that is compatible with every
+        C pointer.  For this reason we need to glob all pointers into one.
+        Still pointers in different address spaces are not compatible.  */
       if (POINTER_TYPE_P (t1))
        {
          if (TYPE_ADDR_SPACE (TREE_TYPE (t1))
              != TYPE_ADDR_SPACE (TREE_TYPE (t2)))
            return false;
-
-         if (TREE_CODE (TREE_TYPE (t1)) != TREE_CODE (TREE_TYPE (t2)))
-           return false;
        }
 
       /* Tail-recurse to components.  */