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: [gfortran] Fix PR 17941 (3rd attempt)


On Saturday 22 January 2005 01:31, Steve Kargl wrote:
> Here's a third patch that fixes fortran/17941.  I've
> included 2 testsuite programs.  Bootstrapped and
> regtested on amd64-*-freebsd6.0

This still doesn't handle signed integer or real constants consistently.

I decided that match_const_complex_part wasn't worth the effort, besides which 
it was incorrect.

The f95 standard (section 4.3.1.3 "Complex type") says that complex constants 
with integer type components have the same type kind as the real typed 
component, or default complex kind type if both components have integer type. 
The existing code parsed (1_8, 1.0_4) as a complex(8) constant, it should be 
complex(4).

Tested on i686-linux.
Applied to mainline.

Paul

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.
Index: arith.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/arith.c,v
retrieving revision 1.20
diff -u -p -r1.20 arith.c
--- arith.c	18 Jan 2005 12:11:44 -0000	1.20
+++ arith.c	23 Jan 2005 21:40:15 -0000
@@ -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;
 }
Index: primary.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/primary.c,v
retrieving revision 1.17
diff -u -p -r1.17 primary.c
--- primary.c	22 Jan 2005 15:24:06 -0000	1.17
+++ primary.c	23 Jan 2005 22:10:15 -0000
@@ -144,6 +144,7 @@ match_digits (int signflag, int radix, c
     {
       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,
   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,
   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,
       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,
 
   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,
     }
 
 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 ** resu
     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);

Attachment: real_const_1.f
Description: Binary data

! { 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

Attachment: complex_int_1.f90
Description: Text document


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