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

Message ID CAKwh3qhJ-3NYhvn9H3E5oSv_A9p1NBweaQF8K9i4qBHO9+vo8w@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 June 11, 2018, 3:05 p.m.
Hi all,

the attached patch fixes two remaining problems with the resolution of
generic functions with POINTER and ALLOCATABLE arguments in F08
(coments 16 & 17 in the PR):
* it deals with an INTENT(IN) condition that was added in an IR
* it deals with polymorphic arguments, which were mistreated previously.

The patch regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2018-06-11  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/45521
    * interface.c (compare_ptr_alloc): New function.
    (compare_ptr_alloc): Call it.


2018-06-11  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/45521
    * gfortran.dg/generic_32.f90: New test.
    * gfortran.dg/generic_33.f90: New test.

Comments

Steve Kargl June 11, 2018, 5:49 p.m. | #1
On Mon, Jun 11, 2018 at 05:05:17PM +0200, Janus Weil wrote:
> 
> the attached patch fixes two remaining problems with the resolution of
> generic functions with POINTER and ALLOCATABLE arguments in F08
> (coments 16 & 17 in the PR):
> * it deals with an INTENT(IN) condition that was added in an IR
> * it deals with polymorphic arguments, which were mistreated previously.
> 
> The patch regtests cleanly on x86_64-linux-gnu. Ok for trunk?
> 

Yes.  Thanks for the patch.
Janus Weil June 11, 2018, 6:45 p.m. | #2
2018-06-11 19:49 GMT+02:00 Steve Kargl <sgk@troutmask.apl.washington.edu>:
> On Mon, Jun 11, 2018 at 05:05:17PM +0200, Janus Weil wrote:
>>
>> the attached patch fixes two remaining problems with the resolution of
>> generic functions with POINTER and ALLOCATABLE arguments in F08
>> (coments 16 & 17 in the PR):
>> * it deals with an INTENT(IN) condition that was added in an IR
>> * it deals with polymorphic arguments, which were mistreated previously.
>>
>> The patch regtests cleanly on x86_64-linux-gnu. Ok for trunk?
>>
>
> Yes.  Thanks for the patch.

Thanks for the review, Steve. Committed as r261448.

Cheers,
Janus

Patch

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 261393)
+++ gcc/fortran/interface.c	(working copy)
@@ -1190,6 +1190,24 @@ 
 }
 
 
+/* Returns true if two dummy arguments are distinguishable due to their POINTER
+   and ALLOCATABLE attributes according to F2018 section 15.4.3.4.5 (3).
+   The function is asymmetric wrt to the arguments s1 and s2 and should always
+   be called twice (with flipped arguments in the second call).  */
+
+static bool
+compare_ptr_alloc(gfc_symbol *s1, gfc_symbol *s2)
+{
+  /* Is s1 allocatable?  */
+  const bool a1 = s1->ts.type == BT_CLASS ?
+		  CLASS_DATA(s1)->attr.allocatable : s1->attr.allocatable;
+  /* Is s2 a pointer?  */
+  const bool p2 = s2->ts.type == BT_CLASS ?
+		  CLASS_DATA(s2)->attr.class_pointer : s2->attr.pointer;
+  return a1 && p2 && (s2->attr.intent != INTENT_IN);
+}
+
+
 /* Perform the correspondence test in rule (3) of F08:C1215.
    Returns zero if no argument is found that satisfies this rule,
    nonzero otherwise. 'p1' and 'p2' are the PASS arguments of both procedures
@@ -1233,8 +1251,8 @@ 
       if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym)
 			 || compare_type_rank (f2->sym, f1->sym))
 	  && !((gfc_option.allow_std & GFC_STD_F2008)
-	       && ((f1->sym->attr.allocatable && f2->sym->attr.pointer)
-		   || (f2->sym->attr.allocatable && f1->sym->attr.pointer))))
+	       && (compare_ptr_alloc(f1->sym, f2->sym)
+		   || compare_ptr_alloc(f2->sym, f1->sym))))
 	goto next;
 
       /* Now search for a disambiguating keyword argument starting at
@@ -1247,8 +1265,8 @@ 
 	  sym = find_keyword_arg (g->sym->name, f2_save);
 	  if (sym == NULL || !compare_type_rank (g->sym, sym)
 	      || ((gfc_option.allow_std & GFC_STD_F2008)
-		  && ((sym->attr.allocatable && g->sym->attr.pointer)
-		      || (sym->attr.pointer && g->sym->attr.allocatable))))
+		  && (compare_ptr_alloc(sym, g->sym)
+		      || compare_ptr_alloc(g->sym, sym))))
 	    return true;
 	}