2008-12-06 Janus Weil <janus@gcc.gnu.org>

	PR fortran/38415
	* expr.c (gfc_check_pointer_assign): Added a check for abstract
	interfaces in procedure pointer assignments, removed check involving
	gfc_compare_interfaces until PR38290 is fixed completely.

2008-12-06  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/38415
	* gfortran.dg/proc_ptr_2.f90: Extended.
	* gfortran.dg/proc_ptr_11.f90: Modified.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@142520 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cdbb23..0fed3d2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-12-06  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/38415
+       * expr.c (gfc_check_pointer_assign): Added a check for abstract
+       interfaces in procedure pointer assignments, removed check involving
+       gfc_compare_interfaces until PR38290 is fixed completely.
+
 2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/38291

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b94e5ac..07dfc7a 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3125,6 +3125,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
                     &rvalue->where);
          return FAILURE;
        }
+      if (attr.abstract)
+       {
+         gfc_error ("Abstract interface '%s' is invalid "
+                    "in procedure pointer assignment at %L",
+                    rvalue->symtree->name, &rvalue->where);
+       }
+      /* TODO. See PR 38290.
       if (rvalue->expr_type == EXPR_VARIABLE
          && lvalue->symtree->n.sym->attr.if_source != IFSRC_UNKNOWN
          && !gfc_compare_interfaces (lvalue->symtree->n.sym,
@@ -3133,7 +3140,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
          gfc_error ("Interfaces don't match "
                     "in procedure pointer assignment at %L", &rvalue->where);
          return FAILURE;
-       }
+       }*/
       return SUCCESS;
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5b26088..2c7ee3c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-12-06  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/38415
+       * gfortran.dg/proc_ptr_2.f90: Extended.
+       * gfortran.dg/proc_ptr_11.f90: Modified.
+
 2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/38291

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
index a5cdbb5..69bf140 100644 (file)
--- a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
@@ -14,8 +14,12 @@ program bsp
   end interface
 
   procedure( up ) , pointer :: pptr
+  procedure(isign), pointer :: q
 
-  pptr => add   ! { dg-error "Interfaces don't match" }
+  ! TODO. See PR 38290.
+  !pptr => add   ! { "Interfaces don't match" }
+
+  q => add
 
   print *, pptr()   ! { dg-error "is not a function" }
 

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
index 6224dc5..98539b9 100644 (file)
--- a/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
@@ -8,10 +8,18 @@ PROCEDURE(REAL), POINTER :: ptr
 PROCEDURE(REAL), SAVE    :: noptr    ! { dg-error "attribute conflicts with" }
 REAL :: x
 
+ abstract interface
+   subroutine bar(a)
+     integer :: a
+   end subroutine bar
+ end interface
+
 ptr => cos(4.0)        ! { dg-error "Invalid procedure pointer assignment" }
 ptr => x               ! { dg-error "Invalid procedure pointer assignment" }
 ptr => sin(x)          ! { dg-error "Invalid procedure pointer assignment" }
 
+ptr => bar             ! { dg-error "is invalid in procedure pointer assignment" }
+
 ALLOCATE(ptr)          ! { dg-error "must be ALLOCATABLE" }
 
 end