FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/25292 (ASSOCIATED( func() ) rejected ?)

Browse source 
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
This commit is contained in:
Erik Edelmann 2005-12-08 16:56:10 +00:00
parent dd2c9f7462
commit 58c0774f29
4 changed files with 49 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -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.

19
gcc/fortran/check.c
View file

@ -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 "

5
gcc/testsuite/ChangeLog
View file

@ -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

23
gcc/testsuite/gfortran.dg/associated_1.f90 Normal file
View file

@ -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