re PR fortran/84313 ([F08] reject procedure pointers in COMMON blocks)

2018-02-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/84313
	* symbol.c (check_conflict): Reject procedure pointers in common blocks.


2018-02-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/84313
	* gfortran.dg/proc_ptr_common_1.f90: Fix invalid test case,
	add necessary compiler options.
	* gfortran.dg/proc_ptr_common_2.f90: Add missing error message.

From-SVN: r257636

gcc/fortran/ChangeLog

+2018-02-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/84313
+	* symbol.c (check_conflict): Reject procedure pointers in common blocks.
+
 2018-02-13  Alastair McKinstry  <alastair.mckinstry@sceal.ie>
 	    Janne Blomqvist  <jb@gcc.gnu.org>
 

gcc/fortran/symbol.c

@@ -809,7 +809,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
 	    conf2 (threadprivate);
 	}
 
-      if (!attr->proc_pointer)
+      /* Procedure pointers in COMMON blocks are allowed in F03,
+       * but forbidden per F08:C5100.  */
+      if (!attr->proc_pointer || (gfc_option.allow_std & GFC_STD_F2008))
 	conf2 (in_common);
 
       conf2 (omp_declare_target_link);

gcc/testsuite/ChangeLog

+2018-02-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/84313
+	* gfortran.dg/proc_ptr_common_1.f90: Fix invalid test case,
+	add necessary compiler options.
+	* gfortran.dg/proc_ptr_common_2.f90: Add missing error message.
+
 2018-02-13  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c/82210

gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90

 ! { dg-do run }
-
+! { dg-options "-std=f2003 -fall-intrinsics" }
+!
 ! PR fortran/36592
 !
 ! Procedure Pointers inside COMMON blocks.
+! (Allowed in F03, but forbidden in F08.)
 !
 ! Contributed by Janus Weil <janus@gcc.gnu.org>.
 
 subroutine one()
   implicit none
-  common /com/ p1,p2,a,b
   procedure(real), pointer :: p1,p2
   integer :: a,b
+  common /com/ p1,p2,a,b
   if (a/=5 .or. b/=-9 .or. p1(0.0)/=1.0 .or. p2(0.0)/=0.0) call abort()
 end subroutine one
 

gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90

@@ -12,7 +12,7 @@ abstract interface
 end interface
 
 procedure(foo), pointer, bind(C) :: proc
-common /com/ proc,r
+common /com/ proc,r  ! { dg-error "PROCEDURE attribute conflicts with COMMON attribute" }
 
 common s
 call s()  ! { dg-error "PROCEDURE attribute conflicts with COMMON attribute" }