diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 41d0bd30613..63a3927c58e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2010-08-15 Tobias Burnus + + * interface.c (compare_pointer, ): Allow passing TARGETs to pointers + dummies with intent(in). + 2010-08-15 Daniel Kraft PR fortran/45197 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 1e72a90a7c4..fa32c5c6999 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1368,6 +1368,11 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual) if (formal->attr.pointer) { attr = gfc_expr_attr (actual); + + /* Fortran 2008 allows non-pointer actual arguments. */ + if (!attr.pointer && attr.target && formal->attr.intent == INTENT_IN) + return 2; + if (!attr.pointer) return 0; } @@ -2113,6 +2118,17 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, return 0; } + if (a->expr->expr_type != EXPR_NULL + && (gfc_option.allow_std & GFC_STD_F2008) == 0 + && compare_pointer (f->sym, a->expr) == 2) + { + if (where) + gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " + "pointer dummy '%s'", &a->expr->where,f->sym->name); + return 0; + } + + /* Fortran 2008, C1242. */ if (f->sym->attr.pointer && gfc_is_coindexed (a->expr)) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 138258fab41..3cdef810b02 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-08-15 Tobias Burnus + + * gfortran.dg/pointer_target_1.f90: New. + * gfortran.dg/pointer_target_2.f90: New. + * gfortran.dg/pointer_target_3.f90: New. + 2010-08-15 Daniel Kraft PR fortran/45197 diff --git a/gcc/testsuite/gfortran.dg/pointer_target_1.f90 b/gcc/testsuite/gfortran.dg/pointer_target_1.f90 new file mode 100644 index 00000000000..0f1b7129b8b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_target_1.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + a = 66 + call foo(a) + if (a /= 647) call abort() +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + if (a /= 66) call abort() + if (p /= 66) call abort() + p = 647 + if (p /= 647) call abort() + if (a /= 647) call abort() + end subroutine foo +end program test diff --git a/gcc/testsuite/gfortran.dg/pointer_target_2.f90 b/gcc/testsuite/gfortran.dg/pointer_target_2.f90 new file mode 100644 index 00000000000..95c3e5f7956 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_target_2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + a = 66 + call foo(a) ! { dg-error "Fortran 2008: Non-pointer actual argument" } + if (a /= 647) call abort() +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + if (a /= 66) call abort() + if (p /= 66) call abort() + p = 647 + if (p /= 647) call abort() + if (a /= 647) call abort() + end subroutine foo +end program test diff --git a/gcc/testsuite/gfortran.dg/pointer_target_3.f90 b/gcc/testsuite/gfortran.dg/pointer_target_3.f90 new file mode 100644 index 00000000000..85e4981cacf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_target_3.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! +! TARGET actual to POINTER dummy with INTENT(IN) +! +program test + implicit none + integer, target :: a + integer :: b + call foo(a) ! OK + call foo(b) ! { dg-error "must be a pointer" } + call bar(a) ! { dg-error "must be a pointer" } + call bar(b) ! { dg-error "must be a pointer" } +contains + subroutine foo(p) + integer, pointer, intent(in) :: p + end subroutine foo + subroutine bar(p) + integer, pointer :: p + end subroutine bar +end program test