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 a350ff29a38ffdf3dbe671a09a7cb5650f225a91..4bfcec4df45be1ca8196c634e7f401d266442100 100644 (file)
--- 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 58c942f6d5b2cc9786b688a88c845d4be5d13f2f..a291bb8b167ce876f6b0c90691ec36d6c5d4a1c2 100644 (file)
--- 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 747f083643a694aca47c15a5312a5ebdb50f2af2..1e4f7efac592b31d63acbca46f79691a2ca675db 100644 (file)
--- 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 (file)
index 0000000..ff0b538
--- /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