[PATCH] g77 FORTRAN extension FORMAT X

[Roger Sayle]

A common extension supported by many fortran compilers, including
AIX f77 and IRIX f77, is to allow the X format to be specified without
an integer prefix.  Unfortunately, this extension is often found in
the source code of many scientific packages (such as the semi-empirical
quantum mechanics program MOPAC) even though the fortran-77 standard
indicates it should formally be written 1X.  The patch below adds
support for this feature/extension to g77.

It turns out this behaviour is already supported by g77's run-time
library, as the run-time parsing of fortran FORMAT statements in
libI77/fmt.c's ne_d routine already treats 'X' as '1X'.  All that's
needed is a tweak to the front-end to avoid issuing an error, except
when the -fpedantic flag has been specified.

The following patch has been tested on i686-pc-linux-gnu with a
bootstrap of the C and FORTRAN compilers, and a "make check-g77"
with no new regressions in the fortran front-end's test suite.

Is such an extension suitable/appropriate for GNU g77?
Is the patch itself Ok for mainline?


Many thanks in advance,


2003-03-15  Roger Sayle  <roger@eyesopen.com>

	* stb.c (ffestb_R100110_): Allow the number before the X format
	to be optional when not -fpedantic.
	* std.c (ffestd_R1001dump_1010_3_): Delete unused static function.
	(ffestd_R1001dump_): For the FFESTP_formattypeX case, call
	ffestd_R1001dump_1010_2_ instead of ffestd_R1001dump_1010_3_.

	* g77.f-torture/compile/xformat.f: New test case.


Index: stb.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/stb.c,v
retrieving revision 1.14
diff -c -3 -p -r1.14 stb.c
*** stb.c	4 Feb 2002 16:07:59 -0000	1.14
--- stb.c	15 Mar 2003 18:04:12 -0000
*************** ffestb_R100110_ (ffelexToken t)
*** 10514,10520 ****

  	case FFESTP_formattypeX:
  	  err = FFEBAD_FORMAT_BAD_X_SPEC;
! 	  pre = required;
  	  post = disallowed;
  	  dot = disallowed;
  	  exp = disallowed;
--- 10514,10520 ----

  	case FFESTP_formattypeX:
  	  err = FFEBAD_FORMAT_BAD_X_SPEC;
! 	  pre = ffe_is_pedantic() ? required : optional;
  	  post = disallowed;
  	  dot = disallowed;
  	  exp = disallowed;
Index: std.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/std.c,v
retrieving revision 1.16
diff -c -3 -p -r1.16 std.c
*** std.c	22 Aug 2002 02:20:42 -0000	1.16
--- std.c	15 Mar 2003 18:04:13 -0000
*************** static void ffestd_R1001dump_1010_1_ (ff
*** 532,539 ****
  				      const char *string);
  static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
  				      const char *string);
- static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
- 				      const char *string);
  static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
  				      const char *string);
  static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
--- 532,537 ----
*************** ffestd_R1001dump_ (ffests s, ffesttForma
*** 3608,3614 ****
  	  break;

  	case FFESTP_formattypeX:
! 	  ffestd_R1001dump_1010_3_ (s, next, "X");
  	  break;

  	case FFESTP_formattypeS:
--- 3606,3612 ----
  	  break;

  	case FFESTP_formattypeX:
! 	  ffestd_R1001dump_1010_2_ (s, next, "X");
  	  break;

  	case FFESTP_formattypeS:
*************** ffestd_R1001dump_1010_2_ (ffests s, ffes
*** 3910,3935 ****
        else
  	ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
      }
-
-   ffests_puts (s, string);
- }
-
- /* ffestd_R1001dump_1010_3_ -- Dump a particular format
-
-    ffesttFormatList f;
-    ffestd_R1001dump_1010_3_(f,"I");
-
-    The format is dumped with form nX.  */
-
- static void
- ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string)
- {
-   assert (f->u.R1010.val.present);
-
-   if (f->u.R1010.val.rtexpr)
-     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
-   else
-     ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);

    ffests_puts (s, string);
  }
--- 3908,3913 ----

       PRINT 10, 2, 3
10     FORMAT (I1, X, I1)
       END


Roger
--
Roger Sayle,                         E-mail: roger@eyesopen.com
OpenEye Scientific Software,         WWW: http://www.eyesopen.com/
Suite 1107, 3600 Cerrillos Road,     Tel: (+1) 505-473-7385
Santa Fe, New Mexico, 87507.         Fax: (+1) 505-473-0833