OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/17941 (gfortran: parser chokes on complex literal constant) 

2004-01-23  Paul Brook  <paul@codesourcery.com>
	Steven G. Kargl  <kargls@comcast.net>

	PR fortran/17941
	* arith.c (gfc_convert_real): Remove sign handling.
	* primary.c (match_digits): Allow whitespace after initial sign.
	(match_real_const): Handle signs here.  Allow whitespace after
	initial sign.  Remove dead code.
	(match_const_complex_part): Remove.
	(match_complex_part): Use match_{real,integer}_const.
	(match_complex_constant): Cross-promote integer types.
testsuite/
	* gfortran.dg/real_const_1.f: New test.
	* gfortran.dg/real_const_2.f90: New test.
	* gfortran.dg/complex_int_1.f90: New test.

From-SVN: r94127
This commit is contained in:
Paul Brook 2005-01-23 22:29:41 +00:00
parent 708bde14ea
commit 69029c61aa
7 changed files with 135 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
2004-01-23 Paul Brook <paul@codesourcery.com>
Steven G. Kargl <kargls@comcast.net>
PR fortran/17941
* arith.c (gfc_convert_real): Remove sign handling.
* primary.c (match_digits): Allow whitespace after initial sign.
(match_real_const): Handle signs here. Allow whitespace after
initial sign. Remove dead code.
(match_const_complex_part): Remove.
(match_complex_part): Use match_{real,integer}_const.
(match_complex_constant): Cross-promote integer types.
2005-01-23 James A. Morrison <phython@gcc.gnu.org>
PR fortran/19294

8
gcc/fortran/arith.c
View File

@ -1928,15 +1928,9 @@ gfc_expr *
gfc_convert_real (const char *buffer, int kind, locus * where)
{
gfc_expr *e;
const char *t;
e = gfc_constant_result (BT_REAL, kind, where);
/* A leading plus is allowed in Fortran, but not by mpfr_set_str */
if (buffer[0] == '+')
t = buffer + 1;
else
t = buffer;
mpfr_set_str (e->value.real, t, 10, GFC_RND_MODE);
mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
return e;
}

217
gcc/fortran/primary.c
View File

@ -144,6 +144,7 @@ match_digits (int signflag, int radix, char *buffer)
{
if (buffer != NULL)
*buffer++ = c;
gfc_gobble_whitespace ();
c = gfc_next_char ();
length++;
}
@ -329,7 +330,8 @@ backup:
}
/* Match a real constant of some sort. */
/* Match a real constant of some sort. Allow a signed constant if signflag
is nonzero. Allow integer constants if allow_int is true. */
static match
match_real_constant (gfc_expr ** result, int signflag)
@ -338,6 +340,7 @@ match_real_constant (gfc_expr ** result, int signflag)
locus old_loc, temp_loc;
char *p, *buffer;
gfc_expr *e;
bool negate;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
@ -348,12 +351,16 @@ match_real_constant (gfc_expr ** result, int signflag)
seen_dp = 0;
seen_digits = 0;
exp_char = ' ';
negate = FALSE;
c = gfc_next_char ();
if (signflag && (c == '+' || c == '-'))
{
if (c == '-')
negate = TRUE;
gfc_gobble_whitespace ();
c = gfc_next_char ();
count++;
}
/* Scan significand. */
@ -392,7 +399,8 @@ match_real_constant (gfc_expr ** result, int signflag)
break;
}
if (!seen_digits || (c != 'e' && c != 'd' && c != 'q'))
if (!seen_digits
|| (c != 'e' && c != 'd' && c != 'q'))
goto done;
exp_char = c;
@ -408,13 +416,6 @@ match_real_constant (gfc_expr ** result, int signflag)
if (!ISDIGIT (c))
{
/* TODO: seen_digits is always true at this point */
if (!seen_digits)
{
gfc_current_locus = old_loc;
return MATCH_NO; /* ".e" can be something else */
}
gfc_error ("Missing exponent in real number at %C");
return MATCH_ERROR;
}
@ -426,7 +427,7 @@ match_real_constant (gfc_expr ** result, int signflag)
}
done:
/* See what we've got! */
/* Check that we have a numeric constant. */
if (!seen_digits || (!seen_dp && exp_char == ' '))
{
gfc_current_locus = old_loc;
@ -440,15 +441,26 @@ done:
buffer = alloca (count + 1);
memset (buffer, '\0', count + 1);
/* Hack for mpfr_set_str(). */
p = buffer;
while (count > 0)
c = gfc_next_char ();
if (c == '+' || c == '-')
{
*p = gfc_next_char ();
if (*p == 'd' || *p == 'q')
gfc_gobble_whitespace ();
c = gfc_next_char ();
}
/* Hack for mpfr_set_str(). */
for (;;)
{
if (c == 'd' || c == 'q')
*p = 'e';
else
*p = c;
p++;
count--;
if (--count == 0)
break;
c = gfc_next_char ();
}
kind = get_kind ();
@ -489,6 +501,8 @@ done:
}
e = gfc_convert_real (buffer, kind, &gfc_current_locus);
if (negate)
mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE);
switch (gfc_range_check (e))
{
@ -994,152 +1008,6 @@ error:
}
/* Match the real and imaginary parts of a complex number. This
subroutine is essentially match_real_constant() modified in a
couple of ways: A sign is always allowed and numbers that would
look like an integer to match_real_constant() are automatically
created as floating point numbers. The messiness involved with
making sure a decimal point belongs to the number and not a
trailing operator is not necessary here either (Hooray!). */
static match
match_const_complex_part (gfc_expr ** result)
{
int kind, seen_digits, seen_dp, count;
char *p, c, exp_char, *buffer;
locus old_loc;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
seen_dp = 0;
seen_digits = 0;
count = 0;
exp_char = ' ';
c = gfc_next_char ();
if (c == '-' || c == '+')
{
c = gfc_next_char ();
count++;
}
for (;; c = gfc_next_char (), count++)
{
if (c == '.')
{
if (seen_dp)
goto no_match;
seen_dp = 1;
continue;
}
if (ISDIGIT (c))
{
seen_digits = 1;
continue;
}
break;
}
if (!seen_digits || (c != 'd' && c != 'e'))
goto done;
exp_char = c;
/* Scan exponent. */
c = gfc_next_char ();
count++;
if (c == '+' || c == '-')
{ /* optional sign */
c = gfc_next_char ();
count++;
}
if (!ISDIGIT (c))
{
gfc_error ("Missing exponent in real number at %C");
return MATCH_ERROR;
}
while (ISDIGIT (c))
{
c = gfc_next_char ();
count++;
}
done:
if (!seen_digits)
goto no_match;
/* Convert the number. */
gfc_current_locus = old_loc;
gfc_gobble_whitespace ();
buffer = alloca (count + 1);
memset (buffer, '\0', count + 1);
/* Hack for mpfr_set_str(). */
p = buffer;
while (count > 0)
{
c = gfc_next_char ();
if (c == 'd' || c == 'q')
c = 'e';
*p++ = c;
count--;
}
*p = '\0';
kind = get_kind ();
if (kind == -1)
return MATCH_ERROR;
/* If the number looked like an integer, forget about a kind we may
have seen, otherwise validate the kind against real kinds. */
if (seen_dp == 0 && exp_char == ' ')
{
if (kind == -2)
kind = gfc_default_integer_kind;
}
else
{
if (exp_char == 'd')
{
if (kind != -2)
{
gfc_error
("Real number at %C has a 'd' exponent and an explicit kind");
return MATCH_ERROR;
}
kind = gfc_default_double_kind;
}
else
{
if (kind == -2)
kind = gfc_default_real_kind;
}
if (gfc_validate_kind (BT_REAL, kind, true) < 0)
{
gfc_error ("Invalid real kind %d at %C", kind);
return MATCH_ERROR;
}
}
*result = gfc_convert_real (buffer, kind, &gfc_current_locus);
return MATCH_YES;
no_match:
gfc_current_locus = old_loc;
return MATCH_NO;
}
/* Match a real or imaginary part of a complex number. */
static match
@ -1151,7 +1019,11 @@ match_complex_part (gfc_expr ** result)
if (m != MATCH_NO)
return m;
return match_const_complex_part (result);
m = match_real_constant (result, 1);
if (m != MATCH_NO)
return m;
return match_integer_constant (result, 1);
}
@ -1210,13 +1082,26 @@ match_complex_constant (gfc_expr ** result)
goto cleanup;
/* Decide on the kind of this complex number. */
kind = gfc_kind_max (real, imag);
if (real->ts.type == BT_REAL)
{
if (imag->ts.type == BT_REAL)
kind = gfc_kind_max (real, imag);
else
kind = real->ts.kind;
}
else
{
if (imag->ts.type == BT_REAL)
kind = imag->ts.kind;
else
kind = gfc_default_real_kind;
}
target.type = BT_REAL;
target.kind = kind;
if (kind != real->ts.kind)
if (real->ts.type != BT_REAL || kind != real->ts.kind)
gfc_convert_type (real, &target, 2);
if (kind != imag->ts.kind)
if (imag->ts.type != BT_REAL || kind != imag->ts.kind)
gfc_convert_type (imag, &target, 2);
e = gfc_convert_complex (real, imag, kind);

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2004-01-23 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
PR fortran/17941
* gfortran.dg/real_const_1.f: New test.
* gfortran.dg/real_const_2.f90: New test.
* gfortran.dg/complex_int_1.f90: New test.
2005-01-23 Bud Davis <bdavis9659@comcast.net>
PR fortran/19313

15
gcc/testsuite/gfortran.dg/complex_int_1.f90 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do compile }
! Complex constants with integer components should take ther kind from
! the real typed component, or default complex type if both components have
! integer type.
program prog
call test1 ((1_8, 1.0_4))
call test2 ((1_8, 2_8))
contains
subroutine test1(x)
complex(4) :: x
end subroutine
subroutine test2(x)
complex :: x
end subroutine
end program

24
gcc/testsuite/gfortran.dg/real_const_1.f Normal file
View File

@ -0,0 +1,24 @@
c { dg-do run }
c
c Fixed form test program for PR 17941 (signed constants with spaces)
c
program real_const_1
complex c0, c1, c2, c3, c4
real rp(4), rn(4)
parameter (c0 = (-0.5, - 0.5))
parameter (c1 = (- 0.5, + 0.5))
parameter (c2 = (- 0.5E2, +0.5))
parameter (c3 = (-0.5, + 0.5E-2))
parameter (c4 = (- 1, + 1))
data rn /- 1.0, - 1d0, - 1.d0, - 10.d-1/
data rp /+ 1.0, + 1d0, + 1.d0, + 10.d-1/
real, parameter :: del = 1.e-5
if (abs(c0 - cmplx(-0.5,-0.5)) > del) call abort
if (abs(c1 - cmplx(-0.5,+0.5)) > del) call abort
if (abs(c2 - cmplx(-0.5E2,+0.5)) > del) call abort
if (abs(c3 - cmplx(-0.5,+0.5E-2)) > del) call abort
if (abs(c4 - cmplx(-1.0,+1.0)) > del) call abort
if (any (abs (rp - 1.0) > del)) call abort
if (any (abs (rn + 1.0) > del)) call abort
end program

24
gcc/testsuite/gfortran.dg/real_const_2.f90 Normal file
View File

@ -0,0 +1,24 @@
! { dg-do run }
!
! Free form test program for PR 17941 (signed constants with spaces)
!
program real_const_2
complex c0, c1, c2, c3, c4
real rp(4), rn(4)
parameter (c0 = (-0.5, - 0.5))
parameter (c1 = (- 0.5, + 0.5))
parameter (c2 = (- 0.5E2, +0.5))
parameter (c3 = (-0.5, + 0.5E-2))
parameter (c4 = (- 1, + 1))
data rn /- 1.0, - 1d0, - 1.d0, - 10.d-1/
data rp /+ 1.0, + 1d0, + 1.d0, + 10.d-1/
real, parameter :: del = 1.e-5
if (abs(c0 - cmplx(-0.5,-0.5)) > del) call abort
if (abs(c1 - cmplx(-0.5,+0.5)) > del) call abort
if (abs(c2 - cmplx(-0.5E2,+0.5)) > del) call abort
if (abs(c3 - cmplx(-0.5,+0.5E-2)) > del) call abort
if (abs(c4 - cmplx(-1.0,+1.0)) > del) call abort
if (any (abs (rp - 1.0) > del)) call abort
if (any (abs (rn + 1.0) > del)) call abort
end program