Commit ebb479cd by Paul Thomas

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
parent 1d72ff1a
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> 2008-10-05 Daniel Kraft <d@domob.eu>
PR fortran/37638 PR fortran/37638
......
...@@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e) ...@@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e)
return MATCH_YES; return MATCH_YES;
} }
static gfc_try check_restricted (gfc_expr *);
/* F95, 7.1.6.1, Initialization expressions, (7) /* F95, 7.1.6.1, Initialization expressions, (7)
F2003, 7.1.7 Initialization expression, (8) */ F2003, 7.1.7 Initialization expression, (8) */
...@@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted) ...@@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted)
} }
else if (not_restricted && check_init_expr (ap->expr) == FAILURE) else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
if (not_restricted == 0
&& ap->expr->expr_type != EXPR_VARIABLE
&& check_restricted (ap->expr) == FAILURE)
return MATCH_ERROR;
} }
return MATCH_YES; return MATCH_YES;
...@@ -2421,8 +2428,6 @@ gfc_match_init_expr (gfc_expr **result) ...@@ -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 /* Given an actual argument list, test to see that each argument is a
restricted expression and optionally if the expression type is restricted expression and optionally if the expression type is
integer or character. */ integer or character. */
...@@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e) ...@@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e)
that host associated dummy array indices are accepted (PR23446). that host associated dummy array indices are accepted (PR23446).
This mechanism also does the same for the specification expressions This mechanism also does the same for the specification expressions
of array-valued functions. */ of array-valued functions. */
if (sym->attr.in_common if (e->error
|| sym->attr.use_assoc || sym->attr.in_common
|| sym->attr.dummy || sym->attr.use_assoc
|| sym->attr.implied_index || sym->attr.dummy
|| sym->ns != gfc_current_ns || sym->attr.implied_index
|| (sym->ns->proc_name != NULL || (sym->ns && sym->ns == gfc_current_ns->parent)
&& sym->ns->proc_name->attr.flavor == FL_MODULE) || (sym->ns && gfc_current_ns->parent
|| (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) && 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; t = SUCCESS;
break; break;
...@@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e) ...@@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e)
gfc_error ("Variable '%s' cannot appear in the expression at %L", gfc_error ("Variable '%s' cannot appear in the expression at %L",
sym->name, &e->where); sym->name, &e->where);
/* Prevent a repetition of the error. */
e->error = 1;
break; break;
case EXPR_NULL: case EXPR_NULL:
......
...@@ -637,10 +637,10 @@ typedef struct ...@@ -637,10 +637,10 @@ typedef struct
unsigned function:1, subroutine:1, procedure:1; unsigned function:1, subroutine:1, procedure:1;
unsigned generic:1, generic_copy:1; unsigned generic:1, generic_copy:1;
unsigned implicit_type:1; /* Type defined via implicit rules. */ 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 is_bind_c:1; /* say if is bound to C. */
unsigned extension:1; /* extends a derived type */ unsigned extension:1; /* extends a derived type. */
/* These flags are both in the typespec and attribute. The attribute /* These flags are both in the typespec and attribute. The attribute
list is what gets read from/written to a module file. The typespec list is what gets read from/written to a module file. The typespec
...@@ -1547,6 +1547,10 @@ typedef struct gfc_expr ...@@ -1547,6 +1547,10 @@ typedef struct gfc_expr
and if we have decided not to allocate temporary data for that array. */ and if we have decided not to allocate temporary data for that array. */
unsigned int inline_noncopying_intrinsic : 1, is_boz : 1; 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. */ /* Used to quickly find a given constructor by its offset. */
splay_tree con_by_offset; splay_tree con_by_offset;
......
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> 2008-10-05 Daniel Kraft <d@domob.eu>
PR fortran/37638 PR fortran/37638
......
! { 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
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