interface.c (compare_pointer, ): Allow passing TARGETs to pointers dummies with inten...

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.

From-SVN: r163262

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 41d0bd30613cdd120dceeecec145bacb6daea670..63a3927c58ecbbc1440f5fe433186385e9c7964d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 1e72a90a7c4b6508f733c8caa58a503153a9c4b0..fa32c5c6999d8147d60486ca28e6af133c655ed9 100644 (file)
--- 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 138258fab41c0ff541dc159008a2b592c68e7ac1..3cdef810b02857d906c626ee84787f8b23607dd6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/pointer_target_1.f90 b/gcc/testsuite/gfortran.dg/pointer_target_1.f90
new file mode 100644 (file)
index 0000000..0f1b712
--- /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 (file)
index 0000000..95c3e5f
--- /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 (file)
index 0000000..85e4981
--- /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