This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR21432 - allow non-standard PRINT namelist-ping
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Cc: joe at confucius dot gnacademy dot org
- Date: Thu, 04 Aug 2005 23:08:53 +0200
- Subject: Re: [Patch, fortran] PR21432 - allow non-standard PRINT namelist-ping
- References: <42F1287C.4070001@wanadoo.fr>
The first version of the patch did not handle -fpedantic and -std=f95
correctly, in spite of the handling of standard compliance being copied
from elsewhere (I will check that other bit of code tomorrow). The
corrected patch is attached.
With the example given in
http://gcc.gnu.org/ml/fortran/2005-08/msg00069.html, I now get the correct;
[prt@localhost mytests]# /gcc-4.1/bin/gfortran print_nml.f
[prt@localhost mytests]# ./a.out
&MYNML
X= 1.000000 ,
Y= 1.000000 , 2.000000 , 3.000000 , 4.000000 ,
5.000000 ,
6.000000 , 7.000000 , 8.000000 , 9.000000 ,
10.00000 , /
[prt@localhost mytests]# /gcc-4.1/bin/gfortran -pedantic print_nml.f
In file print_nml.f:5
print mynml
1
Warning: PRINT namelist at (1) is an extension
[prt@localhost mytests]# /gcc-4.1/bin/gfortran -std=f95 print_nml.f
In file print_nml.f:5
print mynml
1
Error: PRINT namelist at (1) is an extension
OK for mainline, with ChangeLog as before?
Paul T
Index: gcc/gcc/fortran/io.c
===================================================================
RCS file: /cvsroot/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 4 Aug 2005 10:06:19 -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;