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.

From-SVN: r180261

gcc/fortran/ChangeLog

+2011-10-30  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-19  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/47023

gcc/fortran/io.c

@@ -2548,17 +2548,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.  */

gcc/testsuite/ChangeLog

+2011-10-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.dg/format_string.f: New test.
+
+
 2011-10-20  Uros Bizjak  <ubizjak@gmail.com>
 
        * gcc.dg/ipa/ipa-sra-2.c: Add dg-require-effective-target

gcc/testsuite/gfortran.dg/format_string.f

+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