re PR fortran/35680 (ICE on invalid transfer in variable declaration)

2008-10-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35680
	* gfortran.h : Add 'error' bit field to gfc_expr structure.
	* expr.c (check_inquiry): When checking a restricted expression
	check that arguments are either variables or restricted.
	(check_restricted): Do not emit error if the expression has
	'error' set.  Clean up detection of host-associated variable.

2008-10-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35680
	* gfortran.dg/transfer_array_intrinsic_5.f90: New test.

From-SVN: r140892

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index df358b89c3dbf197e041b6da524f55b46f5863b3..53f3f0c1526963e0506e07f9b1f89aee2563ed1b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2008-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/35680
+       * gfortran.h : Add 'error' bit field to gfc_expr structure.
+       * expr.c (check_inquiry): When checking a restricted expression
+       check that arguments are either variables or restricted.
+       (check_restricted): Do not emit error if the expression has
+       'error' set.  Clean up detection of host-associated variable.
+
 2008-10-05  Daniel Kraft  <d@domob.eu>
 
        PR fortran/37638

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7b741b88050e5ffab5c903bd8ebe0d9730b8a3cc..7f6bf1b07e479ea9de68ad8731bbcc846916febe 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e)
   return MATCH_YES;
 }
 
+static gfc_try check_restricted (gfc_expr *);
+
 /* F95, 7.1.6.1, Initialization expressions, (7)
    F2003, 7.1.7 Initialization expression, (8)  */
 
@@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted)
          }
        else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
          return MATCH_ERROR;
+
+       if (not_restricted == 0
+             && ap->expr->expr_type != EXPR_VARIABLE
+             && check_restricted (ap->expr) == FAILURE)
+         return MATCH_ERROR;
     }
 
   return MATCH_YES;
@@ -2421,8 +2428,6 @@ gfc_match_init_expr (gfc_expr **result)
 }
 
 
-static gfc_try check_restricted (gfc_expr *);
-
 /* Given an actual argument list, test to see that each argument is a
    restricted expression and optionally if the expression type is
    integer or character.  */
@@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e)
         that host associated dummy array indices are accepted (PR23446).
         This mechanism also does the same for the specification expressions
         of array-valued functions.  */
-      if (sym->attr.in_common
-         || sym->attr.use_assoc
-         || sym->attr.dummy
-         || sym->attr.implied_index
-         || sym->ns != gfc_current_ns
-         || (sym->ns->proc_name != NULL
-             && sym->ns->proc_name->attr.flavor == FL_MODULE)
-         || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
+      if (e->error
+           || sym->attr.in_common
+           || sym->attr.use_assoc
+           || sym->attr.dummy
+           || sym->attr.implied_index
+           || (sym->ns && sym->ns == gfc_current_ns->parent)
+           || (sym->ns && gfc_current_ns->parent
+                 && sym->ns == gfc_current_ns->parent->parent)
+           || (sym->ns->proc_name != NULL
+                 && sym->ns->proc_name->attr.flavor == FL_MODULE)
+           || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
        {
          t = SUCCESS;
          break;
@@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e)
 
       gfc_error ("Variable '%s' cannot appear in the expression at %L",
                 sym->name, &e->where);
-
+      /* Prevent a repetition of the error.  */
+      e->error = 1;
       break;
 
     case EXPR_NULL:

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 55cca728769278eb1cc70346733c9574c11260b5..b032486abfd54d43392742eb837f9a1ca7ea18fb 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -637,10 +637,10 @@ typedef struct
   unsigned function:1, subroutine:1, procedure:1;
   unsigned generic:1, generic_copy:1;
   unsigned implicit_type:1;    /* Type defined via implicit rules.  */
-  unsigned untyped:1;           /* No implicit type could be found.  */
+  unsigned untyped:1;          /* No implicit type could be found.  */
 
-  unsigned is_bind_c:1;                /* say if is bound to C */
-  unsigned extension:1;                /* extends a derived type */
+  unsigned is_bind_c:1;                /* say if is bound to C.  */
+  unsigned extension:1;                /* extends a derived type.  */
 
   /* These flags are both in the typespec and attribute.  The attribute
      list is what gets read from/written to a module file.  The typespec
@@ -1547,6 +1547,10 @@ typedef struct gfc_expr
      and if we have decided not to allocate temporary data for that array.  */
   unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
 
+  /* Sometimes, when an error has been emitted, it is necessary to prevent
+      it from recurring.  */
+  unsigned int error : 1;
+
   /* Used to quickly find a given constructor by its offset.  */
   splay_tree con_by_offset;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8ea4bef2bf3a25b0e86893f1712acd32e805861f..df7ba0b1e96269df616eb7aec9b6f91a0a152fa1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/35680
+       * gfortran.dg/transfer_array_intrinsic_5.f90: New test.
+
 2008-10-05  Daniel Kraft  <d@domob.eu>
 
        PR fortran/37638

diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90
new file mode 100644 (file)
index 0000000..c886b03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR35680 - used to ICE because the argument of SIZE, being in a restricted
+! expression, was not checked if it too is restricted or is a variable. Since
+! it is neither, an error should be produced.
+!
+! Contributed by  Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program main
+  print *, foo (), bar (), foobar ()
+contains
+  function foo ()
+    integer foo(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+    real x
+ end function
+  function bar()
+    real x
+    integer bar(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+ end function
+  function foobar()                           ! { dg-error "no IMPLICIT" }
+    implicit none
+    integer foobar(size (transfer (x, [1])))  ! { dg-error "used before" }
+    real x
+ end function
+end program