2010-08-15 Tobias Burnus <burnus@net-b.de>
* interface.c (compare_pointer, ): Allow passing TARGETs to pointers dummies with intent(in).
2010-08-15 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/pointer_target_1.f90: New.
* gfortran.dg/pointer_target_2.f90: New.
* gfortran.dg/pointer_target_3.f90: New.
===================================================================
@@ -1368,6 +1368,11 @@ compare_pointer (gfc_symbol *formal, gfc
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 +2133,17 @@ compare_actual_formal (gfc_actual_arglis
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))
{
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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