re PR fortran/23661 ('print fmt' is unclassifiable statement in gfortran)

fortran/
	PR fortran/23661
	* io.c (match_io): Correctly backup if PRINT followed by
	symbol which is not a namelist.  Force blank between PRINT
	and namelist in free form.
testsuite/
	PR fortran/23661
	* gfortran.dg/print_fmt_1.f90, gfortran.dg/print_fmt_2.f90
	gfortran.dg/print_fmt_3.f90: New test.

From-SVN: r103824

gcc/fortran/ChangeLog

+2005-09-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/23661
+	* io.c (match_io): Correctly backup if PRINT followed by
+	symbol which is not a namelist.  Force blank between PRINT
+	and namelist in free form.
+
 2005-08-31  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR fortran/20592

gcc/fortran/io.c

@@ -2133,33 +2133,39 @@ match_io (io_kind k)
 
   if (gfc_match_char ('(') == MATCH_NO)
     {
-      /* Treat the non-standard case of PRINT namelist.  */
-      if (k == M_PRINT && (gfc_match_name (name) == MATCH_YES)
-	    && !gfc_find_symbol (name, NULL, 1, &sym)
-	    && (sym->attr.flavor == FL_NAMELIST))
+      if (k == M_WRITE)
+	goto syntax;
+      else if (k == M_PRINT 
+	       && (gfc_current_form == FORM_FIXED
+		   || gfc_peek_char () == ' '))
 	{
-	  if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
-			      "%C is an extension") == FAILURE)
-	    {
- 	      m = MATCH_ERROR;
-	      goto cleanup;
-	    }
-	  if (gfc_match_eos () == MATCH_NO)
+	  /* Treat the non-standard case of PRINT namelist.  */
+	  where = gfc_current_locus;
+	  if ((gfc_match_name (name) == MATCH_YES)
+	      && !gfc_find_symbol (name, NULL, 1, &sym)
+	      && sym->attr.flavor == FL_NAMELIST)
 	    {
-	      gfc_error ("Namelist followed by I/O list at %C");
-	      m = MATCH_ERROR;
-	      goto cleanup;
-	    }
+	      if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
+				  "%C is an extension") == FAILURE)
+		{
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+	      if (gfc_match_eos () == MATCH_NO)
+		{
+		  gfc_error ("Namelist followed by I/O list at %C");
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
 
-	  dt->io_unit = default_unit (k);
-	  dt->namelist = sym;
-	  goto get_io_list;
+	      dt->io_unit = default_unit (k);
+	      dt->namelist = sym;
+	      goto get_io_list;
+	    }
+	  else
+	    gfc_current_locus = where;
 	}
 
-
-      if (k == M_WRITE)
-	goto syntax;
-
       if (gfc_current_form == FORM_FREE)
        {
          c = gfc_peek_char();

gcc/testsuite/ChangeLog

+2005-09-04  Tobias Schl"uter  <tobias.shclueter@physik.uni-muenchen.de>
+
+	PR fortran/23661
+	* gfortran.dg/print_fmt_1.f90, gfortran.dg/print_fmt_2.f90
+	gfortran.dg/print_fmt_3.f90: New test.
+
 2005-09-03  Jakub Jelinek  <jakub@redhat.com>
 
 	* gfortran.dg/fmt_t_1.f90: New test.

gcc/testsuite/gfortran.dg/print_fmt_1.f90

+! { dg-do run }
+! PR 23661
+! PRINT with a character format was broken
+character(5) :: f = "(a)"
+! { dg-output "check" }
+print f, "check"
+end

gcc/testsuite/gfortran.dg/print_fmt_2.f90

+! { dg-do compile }
+! PR 23661 Make sure space between PRINT and variable name is enforced in
+! free form.
+! Also tests the namelist case
+character(5) :: f = "(a)"
+real  x
+namelist /mynml/ x
+printf, "check" ! { dg-error "Unclassifiable" }
+x = 1
+printmynml ! { dg-error "" }
+end

gcc/testsuite/gfortran.dg/print_fmt_3.f

+! { dg-do compile }
+! PR 23661 Make sure space between PRINT and variable name is not enforced in
+! fixed form.
+! Also tests the namelist case
+      character(5) :: f = "(a)"
+      real  x
+      namelist /mynml/ x
+      printf, "check"
+      x = 1
+      printmynml ! { dg-warning "extension" }
+      end