@@ -607,6 +607,26 @@ fn emit_parameter( |
| 607 | 607 | } |
| 608 | 608 | } |
| 609 | 609 | |
| 610 | +/// Two TypeInfo values represent the same Fortran type. For CHARACTER, |
| 611 | +/// match both kind AND len so a `character(:), allocatable` local does |
| 612 | +/// not get promoted as the result of a `character(3)` function. |
| 613 | +fn result_type_matches(ret: &TypeInfo, cand: &TypeInfo) -> bool { |
| 614 | + use TypeInfo::*; |
| 615 | + match (ret, cand) { |
| 616 | + (Integer { kind: a }, Integer { kind: b }) => a == b, |
| 617 | + (Real { kind: a }, Real { kind: b }) => a == b, |
| 618 | + (DoublePrecision, DoublePrecision) => true, |
| 619 | + (Complex { kind: a }, Complex { kind: b }) => a == b, |
| 620 | + (Logical { kind: a }, Logical { kind: b }) => a == b, |
| 621 | + (Character { kind: ak, len: al }, Character { kind: bk, len: bl }) => ak == bk && al == bl, |
| 622 | + (Derived(a), Derived(b)) => a.eq_ignore_ascii_case(b), |
| 623 | + (Class(a), Class(b)) => a.eq_ignore_ascii_case(b), |
| 624 | + (ClassStar, ClassStar) => true, |
| 625 | + (TypeStar, TypeStar) => true, |
| 626 | + _ => false, |
| 627 | + } |
| 628 | +} |
| 629 | + |
| 610 | 630 | fn emit_procedure( |
| 611 | 631 | out: &mut String, |
| 612 | 632 | name: &str, |
@@ -660,12 +680,40 @@ fn emit_procedure( |
| 660 | 680 | .and_then(|pscope| { |
| 661 | 681 | let arg_set: std::collections::HashSet<String> = |
| 662 | 682 | pscope.arg_order.iter().map(|n| n.to_lowercase()).collect(); |
| 683 | + // The result variable's type matches the function's return |
| 684 | + // type. HashMap iteration order is non-deterministic, so |
| 685 | + // picking the first non-arg variable would non-reproducibly |
| 686 | + // promote ANY local (e.g. `logical :: lfirst(3)` in |
| 687 | + // stdlib_io's parse_mode) to the result name. Match on |
| 688 | + // type_info so the chosen symbol is actually the one |
| 689 | + // standing in for the function result. Surfaced when |
| 690 | + // stdlib's `open(filename, "w")` returned 'r t' from |
| 691 | + // parse_mode — the .amod recorded `result_name=lfirst`, |
| 692 | + // and the function body's writes to `mode_` never reached |
| 693 | + // the result slot. |
| 694 | + let ret_ti = sym.type_info.as_ref(); |
| 663 | 695 | pscope |
| 664 | 696 | .symbols |
| 665 | 697 | .iter() |
| 666 | | - .find(|(key, sym)| { |
| 698 | + .find(|(key, candidate)| { |
| 667 | 699 | !arg_set.contains(*key) |
| 668 | | - && matches!(sym.kind, SymbolKind::Variable | SymbolKind::Parameter) |
| 700 | + && matches!( |
| 701 | + candidate.kind, |
| 702 | + SymbolKind::Variable | SymbolKind::Parameter |
| 703 | + ) |
| 704 | + && match (ret_ti, candidate.type_info.as_ref()) { |
| 705 | + (Some(rt), Some(ct)) => result_type_matches(rt, ct), |
| 706 | + _ => true, |
| 707 | + } |
| 708 | + }) |
| 709 | + .or_else(|| { |
| 710 | + pscope.symbols.iter().find(|(key, candidate)| { |
| 711 | + !arg_set.contains(*key) |
| 712 | + && matches!( |
| 713 | + candidate.kind, |
| 714 | + SymbolKind::Variable | SymbolKind::Parameter |
| 715 | + ) |
| 716 | + }) |
| 669 | 717 | }) |
| 670 | 718 | .map(|(_, sym)| sym.name.clone()) |
| 671 | 719 | }); |