* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163262
138bc75d-0d04-0410-961f-
82ee72b054a4
+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 Daniel Kraft <d@domob.eu>
PR fortran/45197
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;
}
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))
{
+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.
+
2010-08-15 Daniel Kraft <d@domob.eu>
PR fortran/45197
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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