===================================================================
@@ -3307,16 +3307,6 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rval
return false;
}
- /* Assignment is the only case where character variables of different
- kind values can be converted into one another. */
- if (lvalue->ts.type == BT_CHARACTER && rvalue->ts.type == BT_CHARACTER)
- {
- if (lvalue->ts.kind != rvalue->ts.kind && allow_convert)
- return gfc_convert_chartype (rvalue, &lvalue->ts);
- else
- return true;
- }
-
if (!allow_convert)
return true;
===================================================================
@@ -3011,7 +3011,6 @@ char gfc_type_letter (bt);
gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
bool gfc_convert_type (gfc_expr *, gfc_typespec *, int);
bool gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
-bool gfc_convert_chartype (gfc_expr *, gfc_typespec *);
int gfc_generic_intrinsic (const char *);
int gfc_specific_intrinsic (const char *);
bool gfc_is_intrinsic (gfc_symbol*, int, locus);
===================================================================
@@ -4895,7 +4895,16 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespe
&& gfc_compare_types (&expr->ts, ts))
return true;
- sym = find_conv (&expr->ts, ts);
+ if (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER)
+ {
+ if (expr->ts.kind != ts->kind)
+ sym = find_char_conv (&expr->ts, ts);
+ else
+ return true;
+ }
+ else
+ sym = find_conv (&expr->ts, ts);
+
if (sym == NULL)
goto bad;
@@ -5031,62 +5040,6 @@ bad:
}
-bool
-gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
-{
- gfc_intrinsic_sym *sym;
- locus old_where;
- gfc_expr *new_expr;
- int rank;
- mpz_t *shape;
-
- gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
-
- sym = find_char_conv (&expr->ts, ts);
- gcc_assert (sym);
-
- /* Insert a pre-resolved function call to the right function. */
- old_where = expr->where;
- rank = expr->rank;
- shape = expr->shape;
-
- new_expr = gfc_get_expr ();
- *new_expr = *expr;
-
- new_expr = gfc_build_conversion (new_expr);
- new_expr->value.function.name = sym->lib_name;
- new_expr->value.function.isym = sym;
- new_expr->where = old_where;
- new_expr->ts = *ts;
- new_expr->rank = rank;
- new_expr->shape = gfc_copy_shape (shape, rank);
-
- gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
- new_expr->symtree->n.sym->ts.type = ts->type;
- new_expr->symtree->n.sym->ts.kind = ts->kind;
- new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
- new_expr->symtree->n.sym->attr.function = 1;
- new_expr->symtree->n.sym->attr.elemental = 1;
- new_expr->symtree->n.sym->attr.referenced = 1;
- gfc_intrinsic_symbol(new_expr->symtree->n.sym);
- gfc_commit_symbol (new_expr->symtree->n.sym);
-
- *expr = *new_expr;
-
- free (new_expr);
- expr->ts = *ts;
-
- if (gfc_is_constant_expr (expr->value.function.actual->expr)
- && !do_simplify (sym, expr))
- {
- /* Error already generated in do_simplify() */
- return false;
- }
-
- return true;
-}
-
-
/* Check if the passed name is name of an intrinsic (taking into account the
current -std=* and -fall-intrinsic settings). If it is, see if we should
warn about this as a user-procedure having the same name as an intrinsic