re PR fortran/38415 (procedure pointer assignment to abstract interface)

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.

From-SVN: r142520

gcc/fortran/ChangeLog

+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

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;
     }
 

gcc/testsuite/ChangeLog

+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

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" }
 

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