Patchwork fortran/50407 -- Format strings from user-defined operator or kind type string

login
register
mail settings
Submitter Steve Kargl
Date Oct. 16, 2011, 7:38 p.m.
Message ID <20111016193803.GA22258@troutmask.apl.washington.edu>
Download mbox | patch
Permalink /patch/120058/
State New
Headers show

Comments

Steve Kargl - Oct. 16, 2011, 7:38 p.m.
The attach patch fixes the construction of a format string
from a user-defined operator or from a string with a kind
type prefix.  In short, the patch allows

print 2.ip.8  ! .ip. is a user-defined operator
print 1_'(A)' ! 1_ designates a default character type

Prior to this patch gfortran would try to match a statement
label.

2011-10-16  Steven G. Kargl  <kargl@gcc.gnu.org>

	* io.c (match_dt_format): Match a user-defined operator or a kind
	type prefixed string.

2011-10-16  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.dg/format_string.f: New test.
Tobias Burnus - Oct. 17, 2011, 10:07 a.m.
On 10/16/2011 09:38 PM, Steve Kargl wrote:
> The attach patch fixes the construction of a format string
> from a user-defined operator or from a string with a kind
> type prefix.

OK. Thanks for the patch.

Tobias

> 2011-10-16  Steven G. Kargl<kargl@gcc.gnu.org>
>
> 	* io.c (match_dt_format): Match a user-defined operator or a kind
> 	type prefixed string.
>
> 2011-10-16  Steven G. Kargl<kargl@gcc.gnu.org>
>
> 	* gfortran.dg/format_string.f: New test.
>

Patch

Index: fortran/io.c
===================================================================
--- fortran/io.c	(revision 179940)
+++ fortran/io.c	(working copy)
@@ -2548,17 +2554,31 @@  match_dt_format (gfc_dt *dt)
 
   if ((m = gfc_match_st_label (&label)) == MATCH_YES)
     {
-      if (dt->format_expr != NULL || dt->format_label != NULL)
+      char c;
+
+      /* Need to check if the format label is actually either an operand
+	 to a user-defined operator or is a kind type parameter.  That is,
+	 print 2.ip.8      ! .ip. is a user-defined operator return CHARACTER.
+	 print 1_'(I0)', i ! 1_'(I0)' is a default character string.  */
+
+      gfc_gobble_whitespace ();
+      c = gfc_peek_ascii_char ();
+      if (c == '.' || c == '_')
+	gfc_current_locus = where;
+      else
 	{
-	  gfc_free_st_label (label);
-	  goto conflict;
-	}
+	  if (dt->format_expr != NULL || dt->format_label != NULL)
+	    {
+	      gfc_free_st_label (label);
+	      goto conflict;
+	    }
 
-      if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE)
-	return MATCH_ERROR;
+	  if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE)
+	    return MATCH_ERROR;
 
-      dt->format_label = label;
-      return MATCH_YES;
+	  dt->format_label = label;
+	  return MATCH_YES;
+	}
     }
   else if (m == MATCH_ERROR)
     /* The label was zero or too large.  Emit the correct diagnosis.  */
Index: testsuite/gfortran.dg/format_string.f
===================================================================
--- testsuite/gfortran.dg/format_string.f	(revision 0)
+++ testsuite/gfortran.dg/format_string.f	(revision 0)
@@ -0,0 +1,31 @@ 
+c { dg-do compile }
+c PR fortran/50407
+c
+      program bar
+
+      interface operator (.ip.)
+        function mul (i1, i2)
+          character(20) mul
+          intent(in) :: i1,i2
+        end function
+      end interface
+
+      character(20) foo
+      i=3
+      j=4
+      print 2.ip.8  ! compiles fine 
+      print i.ip.2  ! compiles fine 
+      print i.ip.j  ! compiles fine
+      foo = 1_'(I0,I4.4)'
+      print foo, i,j
+      print 1_'(I0,1X,I4.4)', i, j
+      end
+
+      function mul (i1, i2)
+        character(20) mul
+        intent(in) :: i1,i2
+        integer prod
+        prod=i1*i2
+        write(mul,100) prod
+100     format("('ok ",i2,"')")
+      end function