diff mbox

PR fortran/78033 -- This was a REAL pain

Message ID 20161022002241.GA38269@troutmask.apl.washington.edu
State Superseded
Headers show

Commit Message

Steve Kargl Oct. 22, 2016, 12:22 a.m. UTC
All,

The attached patch fixes PR fortran/78033.  This was a REAL pain
to fix because Fortran overloads REAL as an intrinsic type and
an intrinsic subprogram.

gfc_match_type_spec() in match.c is used to match Fortran 2003
type-specs in things like array constructors and TYPE IS statements.
At some point in time, PR fortran/54730 was submitted because an ICE
occurred for

  subroutine s
    implicit none
    intrinsic :: real
    real :: vec(1:2)
    vec = (/ real(a = 1), 1. /)
  end subroutine s

where a symbol for 'a' was create while parsing for a validate
typespec.  The invalid 'a' was causing an ICE during translation.
Mikael fixed the ICE by introducing checkpointing of the symbols in
gfc_match_array_constructor() in array.c, which allowed 'a' to be
removed.

Fast-forward to PR fortran/78033, submitted a few days ago.
Code like 

  subroutine f(n, x)
     integer, intent(in) :: n 
     complex, intent(in) :: x(1:n)
     real :: y(2*n)
     y = [real(x(1:n), aimag(x(1:n))]
  end subroutine f

was now ICE'ing due what appears to be a tangling checkpoint.

f951: internal compiler error: in enforce_single_undo_checkpoint,
at fortran/symbol.c:3514

If I disabled, Mikael's fix for PR fortran/54730 then PR fortran/78033
would compile with the expected regression with PR fortran/54730.  Having
spent to much time looking for a mismatch in checkpoints, I decided to
remove Mikael's fix in gfc_match_array_constructor() and fix the issue
in gfc_match_type_spec() where I special case the parsing of
REAL([KIND]=scalar-int-initialization-expr).

An early version of the patch passed regression except for gomp/udr3.f90.
Note that gfortran never vists gfc_match_type_spec while compling udr3.f90.
I've deleted obj/ and started a clean bootstrap to see if this failure
was collateral damage for my tinkering.  If regression testing is 
successfull, OK to commit?

2016-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78033
	* array.c (gfc_match_array_constructor): Remove checkpointing
	introduced in r196416.  Move initialization to top of function.
	* match.c (gfc_match_type_spec): Special case matching for REAL.

2016-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78033
	* gfortran.dg/pr78033.f90: New test.

-- 
Steve

Comments

Paul Richard Thomas Oct. 22, 2016, 6:55 a.m. UTC | #1
Hi Steve,

Thanks for persevering with this. The patch looks good to me. If it
has regtested OK, please feel free to commit.

Cheers

Paul

On 22 October 2016 at 02:22, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> All,

>

> The attached patch fixes PR fortran/78033.  This was a REAL pain

> to fix because Fortran overloads REAL as an intrinsic type and

> an intrinsic subprogram.

>

> gfc_match_type_spec() in match.c is used to match Fortran 2003

> type-specs in things like array constructors and TYPE IS statements.

> At some point in time, PR fortran/54730 was submitted because an ICE

> occurred for

>

>   subroutine s

>     implicit none

>     intrinsic :: real

>     real :: vec(1:2)

>     vec = (/ real(a = 1), 1. /)

>   end subroutine s

>

> where a symbol for 'a' was create while parsing for a validate

> typespec.  The invalid 'a' was causing an ICE during translation.

> Mikael fixed the ICE by introducing checkpointing of the symbols in

> gfc_match_array_constructor() in array.c, which allowed 'a' to be

> removed.

>

> Fast-forward to PR fortran/78033, submitted a few days ago.

> Code like

>

>   subroutine f(n, x)

>      integer, intent(in) :: n

>      complex, intent(in) :: x(1:n)

>      real :: y(2*n)

>      y = [real(x(1:n), aimag(x(1:n))]

>   end subroutine f

>

> was now ICE'ing due what appears to be a tangling checkpoint.

>

> f951: internal compiler error: in enforce_single_undo_checkpoint,

> at fortran/symbol.c:3514

>

> If I disabled, Mikael's fix for PR fortran/54730 then PR fortran/78033

> would compile with the expected regression with PR fortran/54730.  Having

> spent to much time looking for a mismatch in checkpoints, I decided to

> remove Mikael's fix in gfc_match_array_constructor() and fix the issue

> in gfc_match_type_spec() where I special case the parsing of

> REAL([KIND]=scalar-int-initialization-expr).

>

> An early version of the patch passed regression except for gomp/udr3.f90.

> Note that gfortran never vists gfc_match_type_spec while compling udr3.f90.

> I've deleted obj/ and started a clean bootstrap to see if this failure

> was collateral damage for my tinkering.  If regression testing is

> successfull, OK to commit?

>

> 2016-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

>

>         PR fortran/78033

>         * array.c (gfc_match_array_constructor): Remove checkpointing

>         introduced in r196416.  Move initialization to top of function.

>         * match.c (gfc_match_type_spec): Special case matching for REAL.

>

> 2016-10-21  Steven G. Kargl  <kargl@gcc.gnu.org>

>

>         PR fortran/78033

>         * gfortran.dg/pr78033.f90: New test.

>

> --

> Steve




-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein
diff mbox

Patch

Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 241433)
+++ gcc/fortran/array.c	(working copy)
@@ -1091,7 +1091,6 @@  gfc_match_array_constructor (gfc_expr **
 {
   gfc_constructor *c;
   gfc_constructor_base head;
-  gfc_undo_change_set changed_syms;
   gfc_expr *expr;
   gfc_typespec ts;
   locus where;
@@ -1099,6 +1098,9 @@  gfc_match_array_constructor (gfc_expr **
   const char *end_delim;
   bool seen_ts;
 
+  head = NULL;
+  seen_ts = false;
+
   if (gfc_match (" (/") == MATCH_NO)
     {
       if (gfc_match (" [") == MATCH_NO)
@@ -1115,12 +1117,9 @@  gfc_match_array_constructor (gfc_expr **
     end_delim = " /)";
 
   where = gfc_current_locus;
-  head = NULL;
-  seen_ts = false;
 
   /* Try to match an optional "type-spec ::"  */
   gfc_clear_ts (&ts);
-  gfc_new_undo_checkpoint (changed_syms);
   m = gfc_match_type_spec (&ts);
   if (m == MATCH_YES)
     {
@@ -1130,16 +1129,12 @@  gfc_match_array_constructor (gfc_expr **
 	{
 	  if (!gfc_notify_std (GFC_STD_F2003, "Array constructor "
 			       "including type specification at %C"))
-	    {
-	      gfc_restore_last_undo_checkpoint ();
-	      goto cleanup;
-	    }
+	    goto cleanup;
 
 	  if (ts.deferred)
 	    {
 	      gfc_error ("Type-spec at %L cannot contain a deferred "
 			 "type parameter", &where);
-	      gfc_restore_last_undo_checkpoint ();
 	      goto cleanup;
 	    }
 
@@ -1148,24 +1143,15 @@  gfc_match_array_constructor (gfc_expr **
 	    {
 	      gfc_error ("Type-spec at %L cannot contain an asterisk for a "
 			 "type parameter", &where);
-	      gfc_restore_last_undo_checkpoint ();
 	      goto cleanup;
 	    }
 	}
     }
   else if (m == MATCH_ERROR)
-    {
-      gfc_restore_last_undo_checkpoint ();
-      goto cleanup;
-    }
+    goto cleanup;
 
-  if (seen_ts)
-    gfc_drop_last_undo_checkpoint ();
-  else
-    {
-      gfc_restore_last_undo_checkpoint ();
-      gfc_current_locus = where;
-    }
+  if (!seen_ts)
+    gfc_current_locus = where;
 
   if (gfc_match (end_delim) == MATCH_YES)
     {
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 241433)
+++ gcc/fortran/match.c	(working copy)
@@ -1989,6 +1989,7 @@  gfc_match_type_spec (gfc_typespec *ts)
 {
   match m;
   locus old_locus;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
 
   gfc_clear_ts (ts);
   gfc_gobble_whitespace ();
@@ -2013,13 +2014,6 @@  gfc_match_type_spec (gfc_typespec *ts)
       goto kind_selector;
     }
 
-  if (gfc_match ("real") == MATCH_YES)
-    {
-      ts->type = BT_REAL;
-      ts->kind = gfc_default_real_kind;
-      goto kind_selector;
-    }
-
   if (gfc_match ("double precision") == MATCH_YES)
     {
       ts->type = BT_REAL;
@@ -2053,6 +2047,85 @@  gfc_match_type_spec (gfc_typespec *ts)
       goto kind_selector;
     }
 
+  /* REAL is a real pain because it can be a type or intrinsic subprogram. 
+     Need to differentiate REAL([KIND]=scalar-int-initialization-expr)
+     from REAL(A,[KIND]) and REAL(KIND,A).  */
+
+  m = gfc_match (" %n", name);
+  if (m == MATCH_YES && strcmp (name, "real") == 0)
+    {
+      char c;
+      gfc_expr *e;
+      locus where;
+
+      ts->type = BT_REAL;
+      ts->kind = gfc_default_real_kind;
+
+      gfc_gobble_whitespace ();
+
+      /* Prevent REAL*4, etc.  */
+      c = gfc_peek_ascii_char ();
+      if (c == '*')
+	{
+	  gfc_error ("Invalid type-spec at %C");
+	  return MATCH_ERROR;
+	}
+
+      /* Found leading colon in REAL:: or  trailing ')' in TYPE IS (REAL). */
+      if (c == ':' || c == ')')
+	return MATCH_YES;
+
+      /* Found something other than the opening '(' in REAL(... */
+      if (c != '(')
+	return MATCH_NO;
+      else
+	gfc_next_char (); /* Burn the '('. */
+
+      /* Look for the optional KIND=. */
+      where = gfc_current_locus;
+      m = gfc_match (" %n", name);
+      if (m == MATCH_YES)
+	{
+	  gfc_gobble_whitespace ();
+	  c = gfc_next_char ();
+	  if (c != '=')
+	    gfc_current_locus = where;
+	}
+
+      m = gfc_match_init_expr (&e);
+      if (m == MATCH_NO || m == MATCH_ERROR)
+	return MATCH_NO;
+
+      /* If a comma appears, it is an intrinsic subprogram. */
+      gfc_gobble_whitespace ();
+      c = gfc_peek_ascii_char ();
+      if (c == ',')
+	{
+	  gfc_free_expr (e);
+	  return MATCH_NO;
+	}
+
+      /* If ')' appears, we have REAL(initialization-expr), here check for
+	 a scalar integer initialization-expr and valid kind parameter. */
+      if (c == ')')
+	{
+	  if (e->ts.type != BT_INTEGER || e->rank > 0)
+	    {
+	      gfc_free_expr (e);
+	      return MATCH_NO;
+	    }
+
+	  gfc_next_char (); /* Burn the ')'. */
+	  ts->kind = (int) mpz_get_si (e->value.integer);
+	  if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1)
+	    {
+	      gfc_error ("Invalid type-spec at %C");
+	      return MATCH_ERROR;
+	    }
+	  return MATCH_YES;
+	}
+    }
+
   /* If a type is not matched, simply return MATCH_NO.  */
   gfc_current_locus = old_locus;
   return MATCH_NO;
@@ -2060,6 +2133,8 @@  gfc_match_type_spec (gfc_typespec *ts)
 kind_selector:
 
   gfc_gobble_whitespace ();
+
+  /* This prevents INTEGER*4, etc.  */
   if (gfc_peek_ascii_char () == '*')
     {
       gfc_error ("Invalid type-spec at %C");
@@ -2068,13 +2143,9 @@  kind_selector:
 
   m = gfc_match_kind_spec (ts, false);
 
+  /* No kind specifier found.  */
   if (m == MATCH_NO)
-    m = MATCH_YES;		/* No kind specifier found.  */
-
-  /* gfortran may have matched REAL(a=1), which is the keyword form of the
-     intrinsic procedure.  */
-  if (ts->type == BT_REAL && m == MATCH_ERROR)
-    m = MATCH_NO;
+    m = MATCH_YES;
 
   return m;
 }
Index: gcc/testsuite/gfortran.dg/pr78033.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78033.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78033.f90	(working copy)
@@ -0,0 +1,22 @@ 
+! { dg-do compile }
+subroutine f(n, x, y)
+
+   implicit none
+
+   integer, parameter :: knd = kind(1.e0)
+
+   integer, intent(in) :: n
+   complex(knd), intent(in) :: x(1:n)
+
+   integer i
+   real(knd) y(2*n)
+   
+   y = [real(x), aimag(x)]
+   y = [real(knd) :: 1] 
+   y = [real(kind=42) :: 1] { dg-error "Invalid type-spec" }
+   y = [real(kind=knd) :: 1]
+   y = [real(kind=knd, a=1.)]
+   y = [real(a=1.)]
+   y = [real(a=1, kind=knd)]
+
+end subroutine f