1 files changed, 92 insertions, 4 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index ff279db..10b3e5c 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -2510,9 +2510,9 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
 
   if (src_len > result_len)
     {
-      gfc_warning (0,
-		   "The Hollerith constant at %L is too long to convert to %qs",
-		   &src->where, gfc_typename(&result->ts));
+      gfc_warning (OPT_Wcharacter_truncation, "The Hollerith constant at %L "
+		   "is truncated in conversion to %qs", &src->where,
+		   gfc_typename(&result->ts));
     }
 
   result->representation.string = XCNEWVEC (char, result_len + 1);
@@ -2527,6 +2527,36 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
 }
 
 
+/* Helper function to set the representation in a character conversion.
+   This assumes that the ts.type and ts.kind of the result have already
+   been set.  */
+
+static void
+character2representation (gfc_expr *result, gfc_expr *src)
+{
+  size_t src_len, result_len;
+  int i;
+  src_len = src->value.character.length;
+  gfc_target_expr_size (result, &result_len);
+
+  if (src_len > result_len)
+    gfc_warning (OPT_Wcharacter_truncation, "The character constant at %L is "
+		 "truncated in conversion to %s", &src->where,
+		 gfc_typename(&result->ts));
+
+  result->representation.string = XCNEWVEC (char, result_len + 1);
+
+  for (i = 0; i < MIN (result_len, src_len); i++)
+    result->representation.string[i] = (char) src->value.character.string[i];
+
+  if (src_len < result_len)
+    memset (&result->representation.string[src_len], ' ',
+	    result_len - src_len);
+
+  result->representation.string[result_len] = '\0'; /* For debugger.  */
+  result->representation.length = result_len;
+}
+
 /* Convert Hollerith to integer. The constant will be padded or truncated.  */
 
 gfc_expr *
@@ -2542,8 +2572,21 @@ gfc_hollerith2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert character to integer.  The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_character2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+  character2representation (result, src);
+  gfc_interpret_integer (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, result->value.integer);
+  return result;
+}
 
-/* Convert Hollerith to real. The constant will be padded or truncated.  */
+/* Convert Hollerith to real.  The constant will be padded or truncated.  */
 
 gfc_expr *
 gfc_hollerith2real (gfc_expr *src, int kind)
@@ -2558,6 +2601,21 @@ gfc_hollerith2real (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert character to real.  The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_character2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  character2representation (result, src);
+  gfc_interpret_float (kind, (unsigned char *) result->representation.string,
+		       result->representation.length, result->value.real);
+
+  return result;
+}
+
 
 /* Convert Hollerith to complex. The constant will be padded or truncated.  */
 
@@ -2574,6 +2632,21 @@ gfc_hollerith2complex (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert character to complex. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_character2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  character2representation (result, src);
+  gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, result->value.complex);
+
+  return result;
+}
+
 
 /* Convert Hollerith to character.  */
 
@@ -2609,3 +2682,18 @@ gfc_hollerith2logical (gfc_expr *src, int kind)
 
   return result;
 }
+
+/* Convert character to logical. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_character2logical (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+
+  character2representation (result, src);
+  gfc_interpret_logical (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, &result->value.logical);
+
+  return result;
+}