From 55db3ab206525d78a1be1a708ebc86fc272252f0 Mon Sep 17 00:00:00 2001 From: eedelman Date: Thu, 8 Dec 2005 16:56:10 +0000 Subject: [PATCH] fortran/ 2005-12-08 Erik Edelmann 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 PR fortran/25292 * gfortran.dg/associated_1.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108238 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/check.c | 19 ++++++++++++++----- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/associated_1.f90 | 23 +++++++++++++++++++++++ 4 files changed, 49 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associated_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 65d0cbf..d950f73 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-12-08 Erik Edelmann + + PR fortran/25292 + * check.c (gfc_check_associated): Allow function results + as actual arguments to ASSOCIATED. Moved a misplaced + comment. + 2005-12-07 Rafael Ávila de Espíndola * Make-lang.in (fortran.all.build, fortran.install-normal): Remove. 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 " diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c4e4162..4bc6e51 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-12-08 Erik Edelmann + + PR fortran/25292 + * gfortran.dg/associated_1.f90: New. + 2005-12-08 Eric Botcazou * gfortran.dg/vect/vect-5.f90: Expect alignment forcing only on diff --git a/gcc/testsuite/gfortran.dg/associated_1.f90 b/gcc/testsuite/gfortran.dg/associated_1.f90 new file mode 100644 index 0000000..64cf2b3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_1.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! PR 25292: Check that the intrinsic associated works with functions returning +! pointers as arguments +program test + real, pointer :: a, b + + allocate(a) + if (.not.associated(x(a))) call abort () + if (.not.associated(a, x(a))) call abort () + + nullify(b) + if (associated(x(b))) call abort () + allocate(b) + if (associated(x(b), x(a))) call abort () + +contains + + function x(a) RESULT(b) + real, pointer :: a,b + b => a + end function x + +end program test -- 2.7.4