Hello,
Le 23/04/2013 09:58, Tobias Burnus a écrit :
> The constraint checks for assumed-type and assumed-rank with regards to
> intrinsics only worked very indirectly and, hence, was not strict
> enough. That's now fixed with the attached patch - also for
> NO_ARG_CHECK. For the latter, it also improves the wording a bit and
> allows PRESENT as second permitted intrinsic. (That's the same as for
> TYPE(*) minus the array intrinsics.)
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
> index f4bcdef..78ac0f7 100644
> --- a/gcc/fortran/gfortran.texi
> +++ b/gcc/fortran/gfortran.texi
> @@ -2694,17 +2694,18 @@ with this attribute actual arguments of any type and
> kind (similar to
> @code{TYPE(*)}), scalars and arrays of any rank (no equivalent
> in Fortran standard) are accepted. As with @code{TYPE(*)}, the argument
> is unlimited polymorphic and no type information is available.
> -Additionally, the same restrictions apply, i.e. the argument may only be
> -passed to dummy arguments with the @code{NO_ARG_CHECK} attribute and as
> -argument to the @code{C_LOC} intrinsic function of the @code{ISO_C_BINDING}
> -module.
> +Additionally, the the argument may only be passed to dummy arguments
s/the the/the/
> +with the @code{NO_ARG_CHECK} attribute and as argument to the
> +@code{PRESENT} intrinsic function and to @code{C_LOC} of the
> +@code{ISO_C_BINDING} module.
>
> diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
> index 688332f..cc62c6c 100644
> --- a/gcc/fortran/intrinsic.c
> +++ b/gcc/fortran/intrinsic.c
> @@ -182,10 +182,65 @@ static bool
[...]
> + else if (a->expr->ts.type == BT_ASSUMED
> + && (a != arg
> + || (specific->id != GFC_ISYM_LBOUND
> + && specific->id != GFC_ISYM_PRESENT
> + && specific->id != GFC_ISYM_RANK
> + && specific->id != GFC_ISYM_SHAPE
> + && specific->id != GFC_ISYM_SIZE
> + && specific->id != GFC_ISYM_UBOUND
> + && specific->id != GFC_ISYM_C_LOC)))
I think that when both of the || conditions are true...
> + {
> + if (a != arg)
> + gfc_error ("Assumed-type argument at %L is only permitted as "
> + "first actual argument to the intrinsic %s",
> + &a->expr->where, gfc_current_intrinsic);
> + else
> + gfc_error ("Assumed-type argument at %L is not permitted as actual"
> + " argument to the intrinsic %s", &a->expr->where,
> + gfc_current_intrinsic);
> + return false;
> + }
... the second error should be preferred.
Testcase:
subroutine thirteen(x, y)
type(*) :: x
integer, pointer :: y
print *, associated(y, x)
print *, associated(x)
end subroutine thirteen
output:
test.f90:4.26:
print *, associated(y, x)
1
Error: Assumed-type argument at (1) is only permitted as first actual
argument to the intrinsic associated
test.f90:5.23:
print *, associated(x)
1
Error: Assumed-type argument at (1) is not permitted as actual argument
to the intrinsic associated
Otherwise looks good.
Mikael
