Commit 6869e9c6 by Fritz Reese Committed by Fritz Reese

Default missing exponents to 0 with -fdec.

	gcc/fortran/
	* gfortran.texi: Document.
	* gfortran.h (gfc_dt): New field default_exp.
	* primary.c (match_real_constant): Default exponent with -fdec.
	* io.c (match_io): Set dt.default_exp with -fdec.
	* ioparm.def (IOPARM_dt_default_exp): New.
	* trans-io.c (build_dt): Set IOPARM_dt_default_exp with -fdec.

	libgfortran/io/
	* io.h (IOPARM_DT_DEFAULT_EXP): New flag bit.
	* list_read.c (parse_real, read_real): Allow omission of exponent with
	IOPARM_DT_DEFAULT_EXP.
	* read.c (read_f): Ditto.

	gcc/testsuite/gfortran.dg/
	* dec_exp_1.f90, dec_exp_2.f90, dec_exp_3.f90: New testcases.

From-SVN: r241828
parent 1bac673f
2016-11-03 Fritz Reese <fritzoreese@gmail.com>
* gfortran.texi: Document.
* gfortran.h (gfc_dt): New field default_exp.
* primary.c (match_real_constant): Default exponent with -fdec.
* io.c (match_io): Set dt.default_exp with -fdec.
* ioparm.def (IOPARM_dt_default_exp): New.
* trans-io.c (build_dt): Set IOPARM_dt_default_exp with -fdec.
2016-11-03 Fritz O. Reese <fritzoreese@gmail.com> 2016-11-03 Fritz O. Reese <fritzoreese@gmail.com>
* decl.c (gfc_match_parameter): Allow omitted '()' with -std=legacy. * decl.c (gfc_match_parameter): Allow omitted '()' with -std=legacy.
......
...@@ -2336,6 +2336,7 @@ typedef struct ...@@ -2336,6 +2336,7 @@ typedef struct
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg, gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round, *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
*sign, *extra_comma, *dt_io_kind, *udtio; *sign, *extra_comma, *dt_io_kind, *udtio;
char default_exp;
gfc_symbol *namelist; gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */ /* A format_label of `format_asterisk' indicates the "*" format */
......
...@@ -1472,6 +1472,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}. ...@@ -1472,6 +1472,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
* Bitwise logical operators:: * Bitwise logical operators::
* Extended I/O specifiers:: * Extended I/O specifiers::
* Legacy PARAMETER statements:: * Legacy PARAMETER statements::
* Default exponents::
@end menu @end menu
@node Old-style kind specifications @node Old-style kind specifications
...@@ -2713,6 +2714,14 @@ real c ...@@ -2713,6 +2714,14 @@ real c
parameter c = 3.0e8 parameter c = 3.0e8
@end smallexample @end smallexample
@node Default exponents
@subsection Default exponents
@cindex exponent
For compatibility, GNU Fortran supports a default exponent of zero in real
constants with @option{-fdec}. For example, @code{9e} would be
interpreted as @code{9e0}, rather than an error.
@node Extensions not implemented in GNU Fortran @node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran @section Extensions not implemented in GNU Fortran
......
...@@ -4167,6 +4167,10 @@ get_io_list: ...@@ -4167,6 +4167,10 @@ get_io_list:
goto syntax; goto syntax;
} }
/* See if we want to use defaults for missing exponents in real transfers. */
if (flag_dec)
dt->default_exp = 1;
/* A full IO statement has been matched. Check the constraints. spec_end is /* A full IO statement has been matched. Check the constraints. spec_end is
supplied for cases where no locus is supplied. */ supplied for cases where no locus is supplied. */
m = check_io_constraints (k, dt, io_code, &spec_end); m = check_io_constraints (k, dt, io_code, &spec_end);
......
...@@ -118,4 +118,5 @@ IOPARM (dt, round, 1 << 23, char2) ...@@ -118,4 +118,5 @@ IOPARM (dt, round, 1 << 23, char2)
IOPARM (dt, sign, 1 << 24, char1) IOPARM (dt, sign, 1 << 24, char1)
#define IOPARM_dt_f2003 (1 << 25) #define IOPARM_dt_f2003 (1 << 25)
#define IOPARM_dt_dtio (1 << 26) #define IOPARM_dt_dtio (1 << 26)
#define IOPARM_dt_default_exp (1 << 27)
IOPARM (dt, u, 0, pad) IOPARM (dt, u, 0, pad)
...@@ -483,7 +483,7 @@ backup: ...@@ -483,7 +483,7 @@ backup:
static match static match
match_real_constant (gfc_expr **result, int signflag) match_real_constant (gfc_expr **result, int signflag)
{ {
int kind, count, seen_dp, seen_digits, is_iso_c; int kind, count, seen_dp, seen_digits, is_iso_c, default_exponent;
locus old_loc, temp_loc; locus old_loc, temp_loc;
char *p, *buffer, c, exp_char; char *p, *buffer, c, exp_char;
gfc_expr *e; gfc_expr *e;
...@@ -494,6 +494,7 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -494,6 +494,7 @@ match_real_constant (gfc_expr **result, int signflag)
e = NULL; e = NULL;
default_exponent = 0;
count = 0; count = 0;
seen_dp = 0; seen_dp = 0;
seen_digits = 0; seen_digits = 0;
...@@ -575,8 +576,14 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -575,8 +576,14 @@ match_real_constant (gfc_expr **result, int signflag)
if (!ISDIGIT (c)) if (!ISDIGIT (c))
{ {
gfc_error ("Missing exponent in real number at %C"); /* With -fdec, default exponent to 0 instead of complaining. */
return MATCH_ERROR; if (flag_dec)
default_exponent = 1;
else
{
gfc_error ("Missing exponent in real number at %C");
return MATCH_ERROR;
}
} }
while (ISDIGIT (c)) while (ISDIGIT (c))
...@@ -597,8 +604,8 @@ done: ...@@ -597,8 +604,8 @@ done:
gfc_current_locus = old_loc; gfc_current_locus = old_loc;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
buffer = (char *) alloca (count + 1); buffer = (char *) alloca (count + default_exponent + 1);
memset (buffer, '\0', count + 1); memset (buffer, '\0', count + default_exponent + 1);
p = buffer; p = buffer;
c = gfc_next_ascii_char (); c = gfc_next_ascii_char ();
...@@ -621,6 +628,8 @@ done: ...@@ -621,6 +628,8 @@ done:
c = gfc_next_ascii_char (); c = gfc_next_ascii_char ();
} }
if (default_exponent)
*p++ = '0';
kind = get_kind (&is_iso_c); kind = get_kind (&is_iso_c);
if (kind == -1) if (kind == -1)
......
...@@ -1911,6 +1911,9 @@ build_dt (tree function, gfc_code * code) ...@@ -1911,6 +1911,9 @@ build_dt (tree function, gfc_code * code)
if (dt->udtio) if (dt->udtio)
mask |= IOPARM_dt_dtio; mask |= IOPARM_dt_dtio;
if (dt->default_exp)
mask |= IOPARM_dt_default_exp;
if (dt->namelist) if (dt->namelist)
{ {
if (dt->format_expr || dt->format_label) if (dt->format_expr || dt->format_label)
......
2016-11-03 Fritz Reese <fritzoreese@gmail.com>
* gfortran.dg/dec_exp_1.f90: New test.
* gfortran.dg/dec_exp_2.f90: Likewise.
* gfortran.dg/dec_exp_3.f90: Likewise.
2016-11-03 Fritz O. Reese <fritzoreese@gmail.com> 2016-11-03 Fritz O. Reese <fritzoreese@gmail.com>
* gfortran.dg/dec_parameter_1.f: New test. * gfortran.dg/dec_parameter_1.f: New test.
......
! { dg-do run }
! { dg-options "-fdec" }
!
! Test support for providing a default exponent of zero when unspecified in
! real constants with -fdec.
!
subroutine asserteq (rexp, ract, msg)
real, intent(in) :: rexp, ract
character(*), intent(in) :: msg
if (rexp .ne. ract) then
write (*, '(A,F12.6,F12.6)') msg, rexp, ract
call abort()
endif
end subroutine
implicit none
real, parameter :: r1 = 8e0
real, parameter :: r2 = 8e ! { equivalent to 8e0 }
real, volatile :: r3, r4
character(2) :: s
r3 = 8e ! { equivalent to 8e0 }
s = '8e'
read (s, *) r4
call asserteq (r1, r2, "[const]")
call asserteq (r1, r3, "[vol. ]")
call asserteq (r1, r4, "[read ]")
r4 = 8e + 48e
call asserteq (56e, r4, "[sum ]")
end
! { dg-do compile }
! { dg-options "" }
!
! Make sure we still see an error for missing exponents without -fdec.
!
implicit none
real, parameter :: r1 = 8e ! { dg-error "Missing exponent" }
real, volatile :: r2
r2 = 8e ! { dg-error "Missing exponent" }
end
! { dg-do run "xfail *-*-*" }
! { dg-options "" }
!
! Make sure we still see an error for missing exponents without -fdec.
!
implicit none
real :: r
character(2) :: s
s = '8e'
read (s, *) r ! { XFAIL "Bad real number" }
end
2016-11-03 Fritz Reese <fritzoreese@gmail.com>
* io/io.h (IOPARM_DT_DEFAULT_EXP): New flag bit.
* io/list_read.c (parse_real, read_real): Allow omission of exponent
with IOPARM_DT_DEFAULT_EXP.
* io/read.c (read_f): Ditto.
2016-10-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2016-10-31 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/54679 PR libgfortran/54679
......
...@@ -443,6 +443,7 @@ st_parameter_inquire; ...@@ -443,6 +443,7 @@ st_parameter_inquire;
#define IOPARM_DT_HAS_SIGN (1 << 24) #define IOPARM_DT_HAS_SIGN (1 << 24)
#define IOPARM_DT_HAS_F2003 (1 << 25) #define IOPARM_DT_HAS_F2003 (1 << 25)
#define IOPARM_DT_HAS_UDTIO (1 << 26) #define IOPARM_DT_HAS_UDTIO (1 << 26)
#define IOPARM_DT_DEFAULT_EXP (1 << 27)
/* Internal use bit. */ /* Internal use bit. */
#define IOPARM_DT_IONML_SET (1u << 31) #define IOPARM_DT_IONML_SET (1u << 31)
......
...@@ -1374,7 +1374,16 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) ...@@ -1374,7 +1374,16 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
exp2: exp2:
if (!isdigit (c)) if (!isdigit (c))
goto bad_exponent; {
/* Extension: allow default exponent of 0 when omitted. */
if (dtp->common.flags & IOPARM_DT_DEFAULT_EXP)
{
push_char (dtp, '0');
goto done;
}
else
goto bad_exponent;
}
push_char (dtp, c); push_char (dtp, c);
...@@ -1816,7 +1825,16 @@ read_real (st_parameter_dt *dtp, void * dest, int length) ...@@ -1816,7 +1825,16 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
exp2: exp2:
if (!isdigit (c)) if (!isdigit (c))
goto bad_exponent; {
/* Extension: allow default exponent of 0 when omitted. */
if (dtp->common.flags & IOPARM_DT_DEFAULT_EXP)
{
push_char (dtp, '0');
goto done;
}
else
goto bad_exponent;
}
push_char (dtp, c); push_char (dtp, c);
......
...@@ -1087,7 +1087,13 @@ exponent: ...@@ -1087,7 +1087,13 @@ exponent:
the d parameter before explict conversion takes place. */ the d parameter before explict conversion takes place. */
if (w == 0) if (w == 0)
goto bad_float; {
/* Extension: allow default exponent of 0 when omitted. */
if (dtp->common.flags & IOPARM_DT_DEFAULT_EXP)
goto done;
else
goto bad_float;
}
if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
{ {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment