From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Thu, 20 Oct 2011 17:04:53 +0000 (+0000)
Subject: 2011-10-16  Steven G. Kargl<kargl@gcc.gnu.org>
X-Git-Tag: releases/gcc-4.7.0~2940
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=fc3c9491097e937cbd6d0bc07d15fa39abc590d6;p=thirdparty%2Fgcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a350ff29a38f..4bfcec4df45b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 58c942f6d5b2..a291bb8b167c 100644
--- a/gcc/fortran/io.c
+++ b/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.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 747f083643a6..1e4f7efac592 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/format_string.f b/gcc/testsuite/gfortran.dg/format_string.f
new file mode 100644
index 000000000000..ff0b5388ce92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/format_string.f
@@ -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