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

gcc/fortran/ChangeLog

+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.
+
 2005-12-07  Rafael vila de Espndola  <rafael.espindola@gmail.com>
 
 	* Make-lang.in (fortran.all.build, fortran.install-normal): Remove.

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 "

gcc/testsuite/ChangeLog

+2005-12-08  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25292
+	* gfortran.dg/associated_1.f90: New.
+
 2005-12-08  Eric Botcazou  <ebotcazou@libertysurf.fr>
 
 	* gfortran.dg/vect/vect-5.f90: Expect alignment forcing only on

gcc/testsuite/gfortran.dg/associated_1.f90

+! { 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