re PR fortran/45290 ([F08] pointer initialization)

2011-02-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45290
	* expr.c (gfc_check_assign_symbol): Reject pointers as pointer
	initialization target.

2011-02-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45290
	* gfortran.dg/pointer_init_6.f90: New.

From-SVN: r169948

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4463c8d5e38f64d9911ea6aa46c46c8f73daaeca..8ee85c15b9478e3fdf2ac33bb0bbc2f3e75636c6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2011-02-08  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45290
+       * expr.c (gfc_check_assign_symbol): Reject pointers as pointer
+       initialization target.
+
 2011-02-07  Janne Blomqvist  <jb@gcc.gnu.org>
            Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
 

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index bcc23fc325a1e14caefdc906b5bd9e66ea22cbe8..b30bc64d74ad6a63ef89dc8aabe2789ec9eab303 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3608,7 +3608,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
                     "must not be ALLOCATABLE ");
          return FAILURE;
        }
-      if (!attr.target)
+      if (!attr.target || attr.pointer)
        {
          gfc_error ("Pointer initialization target at %C "
                     "must have the TARGET attribute");
@@ -3621,6 +3621,18 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
          return FAILURE;
        }
     }
+    
+  if (sym->attr.proc_pointer && rvalue->expr_type != EXPR_NULL)
+    {
+      /* F08:C1220. Additional checks for procedure pointer initialization.  */
+      symbol_attribute attr = gfc_expr_attr (rvalue);
+      if (attr.proc_pointer)
+       {
+         gfc_error ("Procedure pointer initialization target at %L "
+                    "may not be a procedure pointer", &rvalue->where);
+         return FAILURE;
+       }
+    }
 
   return SUCCESS;
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5a4fb3dbe71051eb1463025d7d4a1e0f36f36389..1ec8fd246e1be72ee911b1bee60a3403fbbef18b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-08  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45290
+       * gfortran.dg/pointer_init_6.f90: New.
+
 2011-02-08  Jeff Law <law@redhat.com>
 
        PR tree-optimization/42893

diff --git a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
new file mode 100644 (file)
index 0000000..92cece3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m1
+ implicit none
+ type :: t
+   integer, pointer :: p
+   integer :: i
+ end type
+ integer, target :: i
+ type(t), target :: x
+ integer, pointer :: p1 => i
+ integer, pointer :: p2 => p1   ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p3 => x%p  ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p4 => x%i
+end module m1
+
+
+module m2
+
+ type :: t
+   procedure(s), pointer, nopass :: ppc
+ end type
+ type(t) :: x
+ procedure(s), pointer :: pp1 => s
+ procedure(s), pointer :: pp2 => pp1    ! { dg-error "may not be a procedure pointer" }
+ procedure(s), pointer :: pp3 => t%ppc  ! { dg-error "Syntax error" }
+
+contains
+
+  subroutine s
+  end subroutine
+
+end module m2
+
+! { dg-final { cleanup-modules "m1 m2" } }