Hi all, the attached patch does not fix an actual bug, but merely does some cleanup, geting rid of some code duplication. It removes the function gfc_convert_chartype and merges its functionality into the more general gfc_convert_type_warn.
Regtests cleanly on x86_64-linux-gnu. Ok for trunk? Cheers, Janus 2016-12-05 Janus Weil <ja...@gcc.gnu.org> PR fortran/78674 * gfortran.h (gfc_convert_chartype): Remove prototype. * expr.c (gfc_check_assign): Remove special case for character types. * intrinsic.c (gfc_convert_type_warn): Treat also character types. (gfc_convert_chartype): Remove function.
Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 243254) +++ gcc/fortran/expr.c (working copy) @@ -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; Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 243254) +++ gcc/fortran/gfortran.h (working copy) @@ -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); Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 243254) +++ gcc/fortran/intrinsic.c (working copy) @@ -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