Rust · 5536 bytes Raw Blame History
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(&current_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