[Patch, Fortran, cleanup] PR 78674: merge gfc_convert_type_warn and gfc_convert_chartype

[Janus Weil]

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  <janus@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.
-------------- next part --------------
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