1 files changed, 49 insertions, 17 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ac5af10..572967f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4025,6 +4025,29 @@ add_conversions (void)
 	  add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
 		    BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
 	}
+
+  /* DEC legacy feature allows character conversions similar to Hollerith
+     conversions - the character data will transferred on a byte by byte
+     basis.  */
+  if (flag_dec_char_conversions)
+    {
+      /* Character-Integer conversions.  */
+      for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+	add_conv (BT_CHARACTER, gfc_default_character_kind,
+		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+      /* Character-Real conversions.  */
+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+	add_conv (BT_CHARACTER, gfc_default_character_kind,
+		  BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+      /* Character-Complex conversions.  */
+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+	add_conv (BT_CHARACTER, gfc_default_character_kind,
+		  BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+      /* Character-Logical conversions.  */
+      for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+	add_conv (BT_CHARACTER, gfc_default_character_kind,
+		  BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+    }
 }
 
 
@@ -5119,8 +5142,10 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
   /* At this point, a conversion is necessary. A warning may be needed.  */
   if ((gfc_option.warn_std & sym->standard) != 0)
     {
+      const char *type_name = is_char_constant ? gfc_typename (expr)
+					       : gfc_typename (&from_ts);
       gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
-		       gfc_typename (&from_ts), gfc_dummy_typename (ts),
+		       type_name, gfc_dummy_typename (ts),
 		       &expr->where);
     }
   else if (wflag)
@@ -5135,14 +5160,14 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
 	     If range checking was disabled, but -Wconversion enabled,
 	     a non range checked warning is generated below.  */
 	}
-      else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+      else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
+	       && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
 	{
-	  /* Do nothing. This block exists only to simplify the other
-	     else-if expressions.
-	       LOGICAL <> LOGICAL    no warning, independent of kind values
-	       LOGICAL <> INTEGER    extension, warned elsewhere
-	       LOGICAL <> REAL       invalid, error generated elsewhere
-	       LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
+	  const char *type_name = is_char_constant ? gfc_typename (expr)
+						   : gfc_typename (&from_ts);
+	  gfc_warning_now (OPT_Wconversion, "Nonstandard conversion from %s "
+			   "to %s at %L", type_name, gfc_typename (ts),
+			   &expr->where);
 	}
       else if (from_ts.type == ts->type
 	       || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
@@ -5159,7 +5184,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
 				 "conversion from %s to %s at %L",
 				 gfc_typename (&from_ts), gfc_typename (ts),
 				 &expr->where);
-	      else if (warn_conversion_extra)
+	      else
 		gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
 				 "at %L", gfc_typename (&from_ts),
 				 gfc_typename (ts), &expr->where);
@@ -5171,7 +5196,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
 	{
 	  /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
 	     usually comes with a loss of information, regardless of kinds.  */
-	  if (warn_conversion && expr->expr_type != EXPR_CONSTANT)
+	  if (expr->expr_type != EXPR_CONSTANT)
 	    gfc_warning_now (OPT_Wconversion, "Possible change of value in "
 			     "conversion from %s to %s at %L",
 			     gfc_typename (&from_ts), gfc_typename (ts),
@@ -5180,13 +5205,21 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
 	{
 	  /* If HOLLERITH is involved, all bets are off.  */
-	  if (warn_conversion)
-	    gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
-			     gfc_typename (&from_ts), gfc_dummy_typename (ts),
-			     &expr->where);
+	  gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
+			   gfc_typename (&from_ts), gfc_dummy_typename (ts),
+			   &expr->where);
+	}
+      else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+	{
+	  /* Do nothing. This block exists only to simplify the other
+	     else-if expressions.
+	       LOGICAL <> LOGICAL    no warning, independent of kind values
+	       LOGICAL <> INTEGER    extension, warned elsewhere
+	       LOGICAL <> REAL       invalid, error generated elsewhere
+	       LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
 	}
       else
-        gcc_unreachable ();
+	gcc_unreachable ();
     }
 
   /* Insert a pre-resolved function call to the right function.  */
@@ -5244,8 +5277,7 @@ bad:
     }
 
   gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name,
-		      gfc_typename (ts),
-		      &expr->where);
+		      gfc_typename (ts), &expr->where);
   /* Not reached */
 }