[Fortran,F08] PR 45521: GENERIC resolution with ALLOCATABLE/POINTER and PROCEDURE

Message ID CAKwh3qhnykSGQ1fJGGtLCcfLXXcB_SKesJ_EjSMD83k2HiE1mA@mail.gmail.com
State New
Headers show
Series
  • [Fortran,F08] PR 45521: GENERIC resolution with ALLOCATABLE/POINTER and PROCEDURE
Related show

Commit Message

Janus Weil Aug. 4, 2018, 2:50 p.m.
Hi all,

this patch should finally fix up the last wrinkles of PR 45521, which
deals with disambiguating specific procedures in a generic interface
via the pointer/allocatable attributes of the arguments (legal in
F08).

For 'ordinary' generic interfaces this already works (cf.
'generic_correspondence'), but not for operator interfaces, which are
treated a bit differently (see 'gfc_compare_interfaces'). The patch
basically copies over the usage of 'compare_ptr_alloc' from
'generic_correspondence' to the relevant part of
'gfc_compare_interfaces'.

Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2018-08-04  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/45521
    * interface.c (gfc_compare_interfaces): Apply additional
    distinguishability criteria of F08 to operator interfaces.


2018-08-04  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/45521
    * gfortran.dg/interface_assignment_6.f90: New test case.

Patch

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 263178)
+++ gcc/fortran/interface.c	(working copy)
@@ -1776,7 +1776,7 @@ 
 	  }
 	else
 	  {
-	    /* Only check type and rank.  */
+	    /* Operators: Only check type and rank of arguments.  */
 	    if (!compare_type (f2->sym, f1->sym))
 	      {
 		if (errmsg != NULL)
@@ -1794,6 +1794,15 @@ 
 			    symbol_rank (f2->sym));
 		return false;
 	      }
+	    if ((gfc_option.allow_std & GFC_STD_F2008)
+		&& (compare_ptr_alloc(f1->sym, f2->sym)
+		    || compare_ptr_alloc(f2->sym, f1->sym)))
+	      {
+    		if (errmsg != NULL)
+		  snprintf (errmsg, err_len, "Mismatching POINTER/ALLOCATABLE "
+			    "attribute in argument '%s' ", f1->sym->name);
+		return false;
+	      }
 	  }
       }