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