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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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