From: tobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Sun, 4 Sep 2005 12:08:53 +0000 (+0000)
Subject: fortran/
X-Git-Tag: upstream/4.9.2~58869
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=e713bf6dd99b59d450c790b1e7494462a17b459e;p=platform%2Fupstream%2Flinaro-gcc.git

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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103824 138bc75d-0d04-0410-961f-82ee72b054a4
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a03d3df..e88f468 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 5b27ead..37a7493 100644
--- a/gcc/fortran/io.c
+++ b/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();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 17b5b03..c849daa 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_1.f90 b/gcc/testsuite/gfortran.dg/print_fmt_1.f90
new file mode 100644
index 0000000..f7622b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! PR 23661
+! PRINT with a character format was broken
+character(5) :: f = "(a)"
+! { dg-output "check" }
+print f, "check"
+end
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_2.f90 b/gcc/testsuite/gfortran.dg/print_fmt_2.f90
new file mode 100644
index 0000000..c7a5cc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_2.f90
@@ -0,0 +1,11 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_3.f b/gcc/testsuite/gfortran.dg/print_fmt_3.f
new file mode 100644
index 0000000..c46b756
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_3.f
@@ -0,0 +1,11 @@
+! { 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