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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108238 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 65d0cbf..d950f73 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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 Espíndola  <rafael.espindola@gmail.com>
 
        * 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/associated_1.f90 b/gcc/testsuite/gfortran.dg/associated_1.f90
new file mode 100644 (file)
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