| 1 | //! Pointer-assignment target/source validation. |
| 2 | //! |
| 3 | //! Extracted from `core.rs` in Sprint 13. Implements the F2018 §8.5.14 |
| 4 | //! / 10.2.2 rules for `=>`: the LHS must have the POINTER attribute, |
| 5 | //! the RHS must be a valid target (POINTER, TARGET, ALLOCATABLE, or a |
| 6 | //! sub-object of one of those, plus a few function-call escape hatches |
| 7 | //! for `null()` and pointer-valued functions). |
| 8 | |
| 9 | use crate::ast::expr::Expr; |
| 10 | use crate::lexer::Span; |
| 11 | |
| 12 | use super::allocatable::{expr_selects_component, leaf_field_layout}; |
| 13 | use super::core::{extract_base_name, Ctx}; |
| 14 | |
| 15 | pub(super) fn validate_pointer_assignment( |
| 16 | ctx: &mut Ctx, |
| 17 | target: &crate::ast::expr::SpannedExpr, |
| 18 | value: &crate::ast::expr::SpannedExpr, |
| 19 | span: Span, |
| 20 | ) { |
| 21 | // Component-access target (`p%ptr_field => x`): check the leaf |
| 22 | // component's attributes through the type-layout registry. If |
| 23 | // layouts aren't available (older callers) or the chain can't be |
| 24 | // resolved, skip the check rather than flag the base variable. |
| 25 | if expr_selects_component(target) { |
| 26 | if let Some(leaf) = leaf_field_layout(ctx, target) { |
| 27 | if !leaf.field.pointer { |
| 28 | ctx.error( |
| 29 | span, |
| 30 | format!( |
| 31 | "pointer assignment target component '{}' must have pointer attribute", |
| 32 | leaf.field.name |
| 33 | ), |
| 34 | ); |
| 35 | } |
| 36 | } |
| 37 | } else if let Some(name) = extract_base_name(target) { |
| 38 | let is_pointer = ctx.lookup(&name).map(|s| s.attrs.pointer).unwrap_or(true); |
| 39 | if !is_pointer { |
| 40 | ctx.error( |
| 41 | span, |
| 42 | format!( |
| 43 | "pointer assignment target '{}' must have pointer attribute", |
| 44 | name |
| 45 | ), |
| 46 | ); |
| 47 | } |
| 48 | } |
| 49 | |
| 50 | // RHS must have target attribute or be a pointer (or null()/function call). |
| 51 | if expr_selects_component(value) { |
| 52 | // F2018 §8.5.14: a subobject of a TARGET base (or an |
| 53 | // allocated ALLOCATABLE) is itself a valid target, so accept |
| 54 | // when any ancestor on the path carries one of those |
| 55 | // attributes. |
| 56 | if let Some(leaf) = leaf_field_layout(ctx, value) { |
| 57 | let ok = leaf.field.pointer |
| 58 | || leaf.field.allocatable |
| 59 | || leaf.field.target |
| 60 | || leaf.ancestor_is_target |
| 61 | || leaf.ancestor_is_allocatable; |
| 62 | if !ok { |
| 63 | ctx.error(span, format!( |
| 64 | "pointer assignment source component '{}' must have target or pointer attribute", |
| 65 | leaf.field.name |
| 66 | )); |
| 67 | } |
| 68 | } |
| 69 | return; |
| 70 | } |
| 71 | if let Some(name) = extract_base_name(value) { |
| 72 | // Skip if the value is a function call — could be null() or |
| 73 | // pointer-valued function. |
| 74 | if matches!(value.node, Expr::FunctionCall { .. }) { |
| 75 | return; |
| 76 | } |
| 77 | // Dummy procedure arguments are valid RHS targets per F2003 |
| 78 | // (their addresses are implicitly available). |
| 79 | if let Some(sym) = ctx.lookup(&name) { |
| 80 | use crate::sema::symtab::SymbolKind; |
| 81 | if matches!(sym.kind, SymbolKind::Function | SymbolKind::Subroutine) { |
| 82 | return; |
| 83 | } |
| 84 | if sym.attrs.external { |
| 85 | return; |
| 86 | } |
| 87 | } |
| 88 | let ok = ctx |
| 89 | .lookup(&name) |
| 90 | .map(|s| s.attrs.target || s.attrs.pointer) |
| 91 | .unwrap_or(true); |
| 92 | if !ok { |
| 93 | ctx.error( |
| 94 | span, |
| 95 | format!( |
| 96 | "pointer assignment source '{}' must have target or pointer attribute", |
| 97 | name |
| 98 | ), |
| 99 | ); |
| 100 | } |
| 101 | } |
| 102 | } |
| 103 |