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
