This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] PR21432 - allow non-standard PRINT namelist


:ADDPATCH <fortran>:

In spite of the approval from Francois-Xavier, I thought that I should post this one again in its final form. I have added two test cases. The first tests the functionality of the patch and the other that dire things happen if -std=f95 is used.

Regtested on FC3/Athlon

OK for mainline and 4.0?

Paul T

2005-08-10 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/21432.
	* io.c (match_io): Add code to implement PRINT namelist.


2005-08-10 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/21432.
	* gfortran.dg/namelist_print_1.f: New test.
	* gfortran.dg/namelist_print_2.f: New test.


Index: gcc/gcc/fortran/io.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/io.c,v
retrieving revision 1.28
diff -c -3 -p -r1.28 io.c
*** gcc/gcc/fortran/io.c	7 Jul 2005 07:54:42 -0000	1.28
--- gcc/gcc/fortran/io.c	10 Aug 2005 20:18:09 -0000
*************** match_io (io_kind k)
*** 2125,2130 ****
--- 2125,2157 ----
  
    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 (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;
+ 	}
+ 
+         if (k == M_WRITE)
+   	goto syntax;
+   
+ 
        if (k == M_WRITE)
  	goto syntax;
  

namelist_print_1.f
==================

! Test Non standard PRINT namelist - PR21432
!
! Contributor Paul Thomas  <pault@gcc.gnu.org>
!
! { dg-do run }
! { dg-options "-std=gnu" }

      real  x
      namelist /mynml/ x
      x = 1
! ( dg-output "^" }
      print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X=  1.000000    ,  /(\n|\r\n|\r)" }
      end

namelist_print_1.f
==================

! Test Non standard PRINT namelist - PR21432 is
! not accepted by -std=f95
!
! Contributor Paul Thomas  <pault@gcc.gnu.org>
!
! { dg-do compile }
! { dg-options "-std=f95" }
!
      real  x
      namelist /mynml/ x
      x = 1
      print mynml  ! { dg-error "PRINT namelist.*extension" "" }
      end

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]