This patch avoids fold_convert bombing when the types are not variants of the
same base type. It is necessary to avoid regressing with the next patch.
It tries to take the VIEW_CONVERT_EXPR path only when it is necessary and
use the usual fold_convert otherwise. I use gfc_nonrestricted_type in one
assertion, so I had to make it public
For what it's worth, I had another version of this patch which tried harder to
not use VIEW_CONVERT_EXPR by carefully avoiding copying the data pointer
(which is overwritten just after anyway). However, as I didn't want to pull
in the scalarizer to assign arrays, I couldn't avoid VIEW_CONVERT_EXPR in
all cases, so I finally preferred this (simpler) patch.
OK?
2012-08-22 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/45586
* trans-expr.c (gfc_trans_scalar_assign): Wrap in a VIEW_CONVERT_EXPR
node if the types don't match.
* trans-types.c (gfc_nonrestricted_type): Make non-static.
* trans.h (gfc_nonrestricted_type): New declaration.
diff --git a/trans-expr.c b/trans-expr.c
index ebaa238..9dab898 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -6396,8 +6396,24 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse,
gfc_typespec ts,
gfc_add_block_to_block (&block, &rse->pre);
gfc_add_block_to_block (&block, &lse->pre);
- gfc_add_modify (&block, lse->expr,
- fold_convert (TREE_TYPE (lse->expr), rse->expr));
+ tree converted = NULL_TREE;
+ if (TYPE_MAIN_VARIANT (TREE_TYPE (lse->expr))
+ != TYPE_MAIN_VARIANT (TREE_TYPE (rse->expr))
+ && !POINTER_TYPE_P (TREE_TYPE (lse->expr))
+ && !POINTER_TYPE_P (TREE_TYPE (rse->expr)))
+ {
+ gcc_assert (TYPE_CANONICAL (TREE_TYPE (lse->expr))
+ == TYPE_CANONICAL (TREE_TYPE (rse->expr))
+ && gfc_nonrestricted_type (TREE_TYPE (lse->expr))
+ == gfc_nonrestricted_type (TREE_TYPE (rse->expr)));
+ /* fold_convert won't like this. Let's bypass it. */
+ converted = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+ TREE_TYPE (lse->expr), rse->expr);
+ }
+ else
+ converted = fold_convert (TREE_TYPE (lse->expr), rse->expr);
+
+ gfc_add_modify (&block, lse->expr, converted);
/* Do a deep copy if the rhs is a variable, if it is not the
same as the lhs. */
diff --git a/trans-types.c b/trans-types.c
index 3286a5a..a6e5d99 100644
--- a/trans-types.c
+++ b/trans-types.c
@@ -1924,7 +1924,6 @@ gfc_build_pointer_type (gfc_symbol * sym, tree type)
return build_pointer_type (type);
}
-static tree gfc_nonrestricted_type (tree t);
/* Given two record or union type nodes TO and FROM, ensure
that all fields in FROM have a corresponding field in TO,
their type being nonrestrict variants. This accepts a TO
@@ -1973,7 +1972,7 @@ mirror_fields (tree to, tree from)
/* Given a type T, returns a different type of the same structure,
except that all types it refers to (recursively) are always
non-restrict qualified types. */
-static tree
+tree
gfc_nonrestricted_type (tree t)
{
tree ret = t;
diff --git a/trans.h b/trans.h
index 9818ceb..56b6c2f 100644
--- a/trans.h
+++ b/trans.h
@@ -639,6 +639,7 @@ tree getdecls (void);
/* In trans-types.c. */
struct array_descr_info;
bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
+tree gfc_nonrestricted_type (tree);
/* In trans-openmp.c */
bool gfc_omp_privatize_by_reference (const_tree);
