diff options
| author | Erik Edelmann <eedelman@gcc.gnu.org> | 2005-12-08 16:56:10 +0000 |
|---|---|---|
| committer | Erik Edelmann <eedelman@gcc.gnu.org> | 2005-12-08 16:56:10 +0000 |
| commit | 58c0774f29ce61311cff397b8227e426797959a2 (patch) | |
| tree | 48824d8ef6b556f54d14c933adf5e6cbd4e6c1d2 /gcc/fortran/check.c | |
| parent | dd2c9f746201cd614e594d05ce52f832626c66ab (diff) | |
| download | gcc-58c0774f29ce61311cff397b8227e426797959a2.zip gcc-58c0774f29ce61311cff397b8227e426797959a2.tar.gz gcc-58c0774f29ce61311cff397b8227e426797959a2.tar.bz2 | |
re PR fortran/25292 (ASSOCIATED( func() ) rejected ?)
fortran/
2005-12-08 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25292
* check.c (gfc_check_associated): Allow function results
as actual arguments to ASSOCIATED. Moved a misplaced
comment.
testsuite/
2005-12-08 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25292
* gfortran.dg/associated_1.f90: New.
From-SVN: r108238
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 7b71896..feb07f0 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -477,10 +477,13 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target) int i; try t; - if (variable_check (pointer, 0) == FAILURE) - return FAILURE; + if (pointer->expr_type == EXPR_VARIABLE) + attr = gfc_variable_attr (pointer, NULL); + else if (pointer->expr_type == EXPR_FUNCTION) + attr = pointer->symtree->n.sym->attr; + else + gcc_assert (0); /* Pointer must be a variable or a function. */ - attr = gfc_variable_attr (pointer, NULL); if (!attr.pointer) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", @@ -489,10 +492,10 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target) return FAILURE; } + /* Target argument is optional. */ if (target == NULL) return SUCCESS; - /* Target argument is optional. */ if (target->expr_type == EXPR_NULL) { gfc_error ("NULL pointer at %L is not permitted as actual argument " @@ -501,7 +504,13 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target) return FAILURE; } - attr = gfc_variable_attr (target, NULL); + if (target->expr_type == EXPR_VARIABLE) + attr = gfc_variable_attr (target, NULL); + else if (target->expr_type == EXPR_FUNCTION) + attr = target->symtree->n.sym->attr; + else + gcc_assert (0); /* Target must be a variable or a function. */ + if (!attr.pointer && !attr.target) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER " |