Re: {Patch, fortran] PR112834 - Class array function selector causes chain of syntax and other spurious errors

[Harald Anlauf <anlauf@gmx.de>]

Hi Paul,

On 12/6/23 17:09, Paul Richard Thomas wrote:
> Dear All,
>
> This patch was rescued from my ill-fated and long winded attempt to provide
> a fix-up for function selector references, where the function is parsed
> after the procedure containing the associate/select type construct (PRs
> 89645 and 99065). The fix-ups broke down completely once these constructs
> were enclosed by another associate construct, where the selector is a
> derived type or class function. My inclination now is to introduce two pass
> parsing for contained procedures.
>
> Returning to PR112834, the patch is simple enough and is well described by
> the change logs. PR111853 was fixed as a side effect of the bigger patch.
> Steve Kargl had also posted the same fix on the PR.

the patch looks good, but could you please check the coding style?

@@ -6550,7 +6551,19 @@ select_type_set_tmp (gfc_typespec *ts)
        sym = tmp->n.sym;
        gfc_add_type (sym, ts, NULL);

-      if (selector->ts.type == BT_CLASS && selector->attr.class_ok
+      /* If the SELECT TYPE selector is a function we might be able to
obtain
+	 a typespec from the result. Since the function might not have been
+	 parsed yet we have to check that there is indeed a result symbol.  */
+      if (selector->ts.type == BT_UNKNOWN
+	  && gfc_state_stack->construct
+	  && (expr2 = gfc_state_stack->construct->expr2)
+	  && expr2->expr_type == EXPR_FUNCTION
+	  && expr2->symtree
+	  && expr2->symtree->n.sym && expr2->symtree->n.sym->result)

Adding a line break before the second '&&' makes it more readable.

+	selector->ts = expr2->symtree->n.sym->result->ts;

@@ -2037,7 +2038,12 @@ trans_associate_var (gfc_symbol *sym,
gfc_wrapped_block *block)

        /* Class associate-names come this way because they are
  	 unconditionally associate pointers and the symbol is scalar.  */
-      if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
+      if (sym->ts.type == BT_CLASS && e->expr_type ==EXPR_FUNCTION)

There should be whitespace before AND after '=='.

+	{
+	  gfc_conv_expr (&se, e);
+	  se.expr = gfc_evaluate_now (se.expr, &se.pre);
+	}
+      else if (sym->ts.type == BT_CLASS && CLASS_DATA
(sym)->attr.dimension)

> Regression tests - OK for trunk and 13-branch?
>
> Paul
>

Thanks for the patch!

Harald