| 1 | //! `ALLOCATE` / `DEALLOCATE` integrity checks and component-leaf |
| 2 | //! resolution. |
| 3 | //! |
| 4 | //! Extracted from `core.rs` in Sprint 13. Centralizes the rule that |
| 5 | //! only allocatable or pointer entities can appear in `ALLOCATE` / |
| 6 | //! `DEALLOCATE`, and the helper that walks a component-access chain |
| 7 | //! to its leaf `FieldLayout`. Pointer-target validation is in |
| 8 | //! `pointer.rs`; this module is the data side (storage attributes). |
| 9 | |
| 10 | use crate::ast::expr::Expr; |
| 11 | |
| 12 | use super::core::{extract_base_name, Ctx}; |
| 13 | |
| 14 | pub(super) fn validate_allocatable_item( |
| 15 | ctx: &mut Ctx, |
| 16 | item: &crate::ast::expr::SpannedExpr, |
| 17 | stmt_name: &str, |
| 18 | ) { |
| 19 | if expr_selects_component(item) { |
| 20 | if let Some(leaf) = leaf_field_layout(ctx, item) { |
| 21 | if !leaf.field.allocatable && !leaf.field.pointer { |
| 22 | ctx.error( |
| 23 | item.span, |
| 24 | format!( |
| 25 | "only allocatable or pointer components can appear in {}, but '{}' is neither", |
| 26 | stmt_name.to_uppercase(), |
| 27 | leaf.field.name |
| 28 | ), |
| 29 | ); |
| 30 | } |
| 31 | } |
| 32 | return; |
| 33 | } |
| 34 | let base_name = extract_base_name(item); |
| 35 | if let Some(ref name) = base_name { |
| 36 | let ok = ctx |
| 37 | .lookup(name) |
| 38 | .map(|s| s.attrs.allocatable || s.attrs.pointer) |
| 39 | .unwrap_or(true); // unknown symbol — skip |
| 40 | if !ok { |
| 41 | ctx.error( |
| 42 | item.span, |
| 43 | format!( |
| 44 | "only allocatable or pointer variables can appear in {}, but '{}' is neither", |
| 45 | stmt_name.to_uppercase(), |
| 46 | name |
| 47 | ), |
| 48 | ); |
| 49 | } |
| 50 | } |
| 51 | } |
| 52 | |
| 53 | pub(super) fn allocate_item_needs_explicit_shape( |
| 54 | ctx: &Ctx<'_>, |
| 55 | item: &crate::ast::expr::SpannedExpr, |
| 56 | ) -> bool { |
| 57 | match &item.node { |
| 58 | Expr::Name { name } => ctx |
| 59 | .allocatable_array_targets |
| 60 | .contains(&(ctx.scope_id, name.to_lowercase())), |
| 61 | Expr::ParenExpr { inner } => allocate_item_needs_explicit_shape(ctx, inner), |
| 62 | Expr::ComponentAccess { .. } => leaf_field_layout(ctx, item) |
| 63 | .map(|leaf| leaf.field.declared_array) |
| 64 | .unwrap_or(false), |
| 65 | _ => false, |
| 66 | } |
| 67 | } |
| 68 | |
| 69 | /// Does this expression select into a derived-type component |
| 70 | /// anywhere in its path? e.g. `pools(i)%tokens(n)` → true, |
| 71 | /// `pools(i)` → false, `pools` → false. |
| 72 | pub(super) fn expr_selects_component(expr: &crate::ast::expr::SpannedExpr) -> bool { |
| 73 | match &expr.node { |
| 74 | Expr::ComponentAccess { .. } => true, |
| 75 | Expr::FunctionCall { callee, .. } => expr_selects_component(callee), |
| 76 | _ => false, |
| 77 | } |
| 78 | } |
| 79 | |
| 80 | /// Resolved metadata for the leaf of a component access. |
| 81 | pub(super) struct LeafComponent<'a> { |
| 82 | pub(super) field: &'a crate::sema::type_layout::FieldLayout, |
| 83 | /// Any ancestor on the path (including the base variable or any |
| 84 | /// intermediate component) has the TARGET attribute. F2018 |
| 85 | /// §8.5.14: a subobject of a TARGET is itself a valid target. |
| 86 | pub(super) ancestor_is_target: bool, |
| 87 | /// Any ancestor is ALLOCATABLE — per §8.5.14, an allocated |
| 88 | /// subobject of an allocatable is also a valid target. |
| 89 | pub(super) ancestor_is_allocatable: bool, |
| 90 | } |
| 91 | |
| 92 | /// Walk an expression down to its leaf component access and return |
| 93 | /// that component's FieldLayout (with attribute metadata). Returns |
| 94 | /// `None` if the expression has no component access, or if the |
| 95 | /// chain's derived-type path can't be resolved through the symbol |
| 96 | /// table + layout registry (for example, a field whose type is a |
| 97 | /// derived type that wasn't in the registry — uncommon but possible |
| 98 | /// when a cross-TU .amod is stale). |
| 99 | pub(super) fn leaf_field_layout<'a>( |
| 100 | ctx: &'a Ctx, |
| 101 | expr: &crate::ast::expr::SpannedExpr, |
| 102 | ) -> Option<LeafComponent<'a>> { |
| 103 | let layouts = ctx.type_layouts?; |
| 104 | let mut chain: Vec<&str> = Vec::new(); |
| 105 | let mut cur = expr; |
| 106 | let base_name = loop { |
| 107 | match &cur.node { |
| 108 | Expr::ComponentAccess { base, component } => { |
| 109 | chain.push(component.as_str()); |
| 110 | cur = base; |
| 111 | } |
| 112 | Expr::FunctionCall { callee, .. } => { |
| 113 | cur = callee; |
| 114 | } |
| 115 | Expr::Name { name } => break name.as_str(), |
| 116 | _ => return None, |
| 117 | } |
| 118 | }; |
| 119 | chain.reverse(); |
| 120 | if chain.is_empty() { |
| 121 | return None; |
| 122 | } |
| 123 | let sym = ctx.lookup(base_name)?; |
| 124 | let base_type = match sym.type_info.as_ref()? { |
| 125 | crate::sema::symtab::TypeInfo::Derived(name) => name.clone(), |
| 126 | _ => return None, |
| 127 | }; |
| 128 | let mut ancestor_is_target = sym.attrs.target; |
| 129 | let mut ancestor_is_allocatable = sym.attrs.allocatable; |
| 130 | let mut current_type = base_type; |
| 131 | let mut leaf: Option<&crate::sema::type_layout::FieldLayout> = None; |
| 132 | for (i, comp) in chain.iter().enumerate() { |
| 133 | let layout = layouts.get(¤t_type)?; |
| 134 | let field = layout.field(comp)?; |
| 135 | let is_terminal = i + 1 == chain.len(); |
| 136 | if !is_terminal { |
| 137 | if field.target { |
| 138 | ancestor_is_target = true; |
| 139 | } |
| 140 | if field.allocatable { |
| 141 | ancestor_is_allocatable = true; |
| 142 | } |
| 143 | } |
| 144 | leaf = Some(field); |
| 145 | if let crate::sema::symtab::TypeInfo::Derived(name) = &field.type_info { |
| 146 | current_type = name.clone(); |
| 147 | } |
| 148 | } |
| 149 | leaf.map(|field| LeafComponent { |
| 150 | field, |
| 151 | ancestor_is_target, |
| 152 | ancestor_is_allocatable, |
| 153 | }) |
| 154 | } |
| 155 |