For the 60th anniversary of Chinese people��s Anti-Japan war victory.

2005-07-07  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/16531
	PR fortran/15966
	PR fortran/18781
	* arith.c (gfc_hollerith2int, gfc_hollerith2real,
	gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
	New functions.
	(eval_intrinsic): Don't evaluate if Hollerith constant arguments exist.
	* arith.h (gfc_hollerith2int, gfc_hollerith2real,
	gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
	Add prototypes.
	* expr.c (free_expr0): Free memery allocated for Hollerith constant.
	(gfc_copy_expr): Allocate and copy string if Expr is from Hollerith.
	(gfc_check_assign): Enable conversion from Hollerith to other.
	* gfortran.h (bt): Add BT_HOLLERITH.
	(gfc_expr): Add from_H flag.
	* intrinsic.c (gfc_type_letter): Return 'h' for BT_HOLLERITH.
	(add_conversions): Add conversions from Hollerith constant to other.
	(do_simplify): Don't simplify if  Hollerith constant arguments exist.
	* io.c (resolve_tag): Enable array in FORMAT tag under GFC_STD_GNU.
	* misc.c (gfc_basetype_name): Return "HOLLERITH" for BT_HOLLERITH.
	(gfc_type_name): Print "HOLLERITH" for BT_HOLLERITH.
	* primary.c (match_hollerith_constant): New function.
	(gfc_match_literal_constant): Add match Hollerith before Integer.
	* simplify.c (gfc_convert_constant): Add conversion from Hollerith
	to other.
	* trans-const.c (gfc_conv_constant_to_tree): Use VIEW_CONVERT_EXPR to
	convert Hollerith constant to tree.
	* trans-io.c (gfc_convert_array_to_string): Get array's address and
	length to set string expr.
	(set_string): Deal with array assigned Hollerith constant and character
	array.
	* gfortran.texi: Document Hollerith constants as extention support.

2005-07-07  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/16531
	PR fortran/15966
	PR fortran/18781
	* gfortran.dg/hollerith.f90: New.
	* gfortran.dg/hollerith2.f90: New.
	* gfortran.dg/hollerith3.f90: New.
	* gfortran.dg/hollerith4.f90: New.
	* gfortran.dg/hollerith_f95.f90: New.
	* gfortran.dg/hollerith_legacy.f90: New.
	* gfortran.dg/g77/cpp4.F: New. Port from g77.

2005-07-07  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/16531
	* io/transfer.c (formatted_transfer): Enable FMT_A on other types to
	support Hollerith constants.

From-SVN: r101688

1 files changed, 166 insertions, 8 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index c85366e..4443f33 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1582,17 +1582,19 @@ eval_intrinsic (gfc_intrinsic_op operator,
   if (operator == INTRINSIC_POWER && op2->ts.type != BT_INTEGER)
     goto runtime;
 
-  if (op1->expr_type != EXPR_CONSTANT
-      && (op1->expr_type != EXPR_ARRAY
-	  || !gfc_is_constant_expr (op1)
-	  || !gfc_expanded_ac (op1)))
+  if (op1->from_H
+      || (op1->expr_type != EXPR_CONSTANT
+	  && (op1->expr_type != EXPR_ARRAY
+	    || !gfc_is_constant_expr (op1)
+	    || !gfc_expanded_ac (op1))))
     goto runtime;
 
   if (op2 != NULL
-      && op2->expr_type != EXPR_CONSTANT
-      && (op2->expr_type != EXPR_ARRAY
-	  || !gfc_is_constant_expr (op2)
-	  || !gfc_expanded_ac (op2)))
+      && (op2->from_H
+	|| (op2->expr_type != EXPR_CONSTANT
+	  && (op2->expr_type != EXPR_ARRAY
+	    || !gfc_is_constant_expr (op2)
+	    || !gfc_expanded_ac (op2)))))
     goto runtime;
 
   if (unary)
@@ -2214,3 +2216,159 @@ gfc_int2log (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert Hollerith to integer. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2int (gfc_expr * src, int kind)
+{
+  gfc_expr *result;
+  int len;
+
+  len = src->value.character.length;
+
+  result = gfc_get_expr ();
+  result->expr_type = EXPR_CONSTANT;
+  result->ts.type = BT_INTEGER;
+  result->ts.kind = kind;
+  result->where = src->where;
+  result->from_H = 1;
+
+  if (len > kind)
+    {
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+		&src->where, gfc_typename(&result->ts));
+    }
+  result->value.character.string = gfc_getmem (kind + 1);
+  memcpy (result->value.character.string, src->value.character.string,
+	MIN (kind, len));
+
+  if (len < kind)
+    memset (&result->value.character.string[len], ' ', kind - len);
+
+  result->value.character.string[kind] = '\0'; /* For debugger */
+  result->value.character.length = kind;
+
+  return result;
+}
+
+/* Convert Hollerith to real. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2real (gfc_expr * src, int kind)
+{
+  gfc_expr *result;
+  int len;
+
+  len = src->value.character.length;
+
+  result = gfc_get_expr ();
+  result->expr_type = EXPR_CONSTANT;
+  result->ts.type = BT_REAL;
+  result->ts.kind = kind;
+  result->where = src->where;
+  result->from_H = 1;
+
+  if (len > kind)
+    {
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+		&src->where, gfc_typename(&result->ts));
+    }
+  result->value.character.string = gfc_getmem (kind + 1);
+  memcpy (result->value.character.string, src->value.character.string,
+	MIN (kind, len));
+
+  if (len < kind)
+    memset (&result->value.character.string[len], ' ', kind - len);
+
+  result->value.character.string[kind] = '\0'; /* For debugger */
+  result->value.character.length = kind;
+
+  return result;
+}
+
+/* Convert Hollerith to complex. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2complex (gfc_expr * src, int kind)
+{
+  gfc_expr *result;
+  int len;
+
+  len = src->value.character.length;
+
+  result = gfc_get_expr ();
+  result->expr_type = EXPR_CONSTANT;
+  result->ts.type = BT_COMPLEX;
+  result->ts.kind = kind;
+  result->where = src->where;
+  result->from_H = 1;
+
+  kind = kind * 2;
+
+  if (len > kind)
+    {
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+		&src->where, gfc_typename(&result->ts));
+    }
+  result->value.character.string = gfc_getmem (kind + 1);
+  memcpy (result->value.character.string, src->value.character.string,
+	MIN (kind, len));
+
+  if (len < kind)
+    memset (&result->value.character.string[len], ' ', kind - len);
+
+  result->value.character.string[kind] = '\0'; /* For debugger */
+  result->value.character.length = kind;
+
+  return result;
+}
+
+/* Convert Hollerith to character. */
+
+gfc_expr *
+gfc_hollerith2character (gfc_expr * src, int kind)
+{
+  gfc_expr *result;
+
+  result = gfc_copy_expr (src);
+  result->ts.type = BT_CHARACTER;
+  result->ts.kind = kind;
+  result->from_H = 1;
+
+  return result;
+}
+
+/* Convert Hollerith to logical. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2logical (gfc_expr * src, int kind)
+{
+  gfc_expr *result;
+  int len;
+
+  len = src->value.character.length;
+
+  result = gfc_get_expr ();
+  result->expr_type = EXPR_CONSTANT;
+  result->ts.type = BT_LOGICAL;
+  result->ts.kind = kind;
+  result->where = src->where;
+  result->from_H = 1;
+
+  if (len > kind)
+    {
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+		&src->where, gfc_typename(&result->ts));
+    }
+  result->value.character.string = gfc_getmem (kind + 1);
+  memcpy (result->value.character.string, src->value.character.string,
+	MIN (kind, len));
+
+  if (len < kind)
+    memset (&result->value.character.string[len], ' ', kind - len);
+
+  result->value.character.string[kind] = '\0'; /* For debugger */
+  result->value.character.length = kind;
+
+  return result;
+}