From 0de3c7ec0204fd192d59cafaa8d0eca23db3c405 Mon Sep 17 00:00:00 2001 From: Jeff Roberts Date: Wed, 23 Sep 2026 19:21:15 -0500 Subject: [PATCH] Class property expressions, class-body arrays, SYS(2007), SET switch words Found running a CodeMine application (Shutter Ace); each behaviour measured in Visual FoxPro 9 first, with goldens whose .expected vfp9.exe wrote. - A DEFINE CLASS property value that is an expression - QuickBooksInvoice's TxnDate = TRANSFORM(DTOS(DATE()), "@R xxxx-xx-xx") - is kept as source and worked out at CREATEOBJECT(), where CREATEOBJECT() was called, so a variable set just before it is seen. A subclass's constant still wins over it. It was a compile error. Evaluating in a fiber that is waiting on the host no longer drops the answer that fiber is waiting for. - A class body can set an array property whole (every element) or one element of it: `DIMENSION wbaSearchOrder[7]` then `wbaSearchOrder[1] = "WIZARDS"`, as Microsoft's own wbmain.prg does. - SYS(2007): CRC-16/CCITT from 0xFFFF or from the seed given, and CRC-32 with flag 1. CodeMine validates serial numbers with it. - Words after a SET switch are read: SET COMPATIBLE ... PROMPT | NOPROMPT is what SET("COMPATIBLE", 1) answers; the words after others change nothing. Co-Authored-By: Claude Opus 5.5 --- crates/foxvm/src/ast.rs | 4 + crates/foxvm/src/builtins/system.rs | 33 ++++++++- crates/foxvm/src/bytecode.rs | 10 +++ crates/foxvm/src/compiler.rs | 73 ++++++++++++++++--- crates/foxvm/src/host.rs | 17 ++++- crates/foxvm/src/parser.rs | 45 +++++++++--- crates/foxvm/src/vm.rs | 5 +- crates/foxvm/tests/classes.rs | 25 ++++--- crates/foxvm/tests/common/mod.rs | 1 + .../programs/class_array_elements.expected | 4 + .../tests/programs/class_array_elements.prg | 18 +++++ .../tests/programs/set_switch_words.expected | 5 ++ .../foxvm/tests/programs/set_switch_words.prg | 11 +++ .../tests/programs/sys_checksum.expected | 12 +++ crates/foxvm/tests/programs/sys_checksum.prg | 13 ++++ src/renderer/src/runtime/session.ts | 9 ++- src/shared/runtime/classDef.ts | 15 +++- src/shared/runtime/classInstance.ts | 31 ++++++-- .../runtime/classPropertyExpressions.test.ts | 55 ++++++++++++++ 19 files changed, 338 insertions(+), 48 deletions(-) create mode 100644 crates/foxvm/tests/programs/class_array_elements.expected create mode 100644 crates/foxvm/tests/programs/class_array_elements.prg create mode 100644 crates/foxvm/tests/programs/set_switch_words.expected create mode 100644 crates/foxvm/tests/programs/set_switch_words.prg create mode 100644 crates/foxvm/tests/programs/sys_checksum.expected create mode 100644 crates/foxvm/tests/programs/sys_checksum.prg create mode 100644 tests/runtime/classPropertyExpressions.test.ts diff --git a/crates/foxvm/src/ast.rs b/crates/foxvm/src/ast.rs index d462eda..04bccd3 100644 --- a/crates/foxvm/src/ast.rs +++ b/crates/foxvm/src/ast.rs @@ -91,6 +91,8 @@ pub struct ClassProperty { pub value: Expr, /// `DIMENSION aRGB[3]` in a class body: the property is an array of this many elements. pub dim: Option, + /// `aRGB[2] = 255` in a class body: one element of an array the body dimensioned. + pub index: Option>, } /// `ADD OBJECT [PROTECTED] AS [NOINIT] [WITH = , ...]`. @@ -134,6 +136,8 @@ pub struct Arg { pub enum SetValue { On, Off, + /// `SET COMPATIBLE OFF NOPROMPT`, `SET TALK OFF NOWINDOW`: the switch, and the words after it. + Switch { on: bool, words: String }, To(Vec), /// `SET DATE TO AMERICAN`, `SET CLASSLIB TO x ADDITIVE`: bare words after TO. Word(String), diff --git a/crates/foxvm/src/builtins/system.rs b/crates/foxvm/src/builtins/system.rs index f9012e5..cb3c843 100644 --- a/crates/foxvm/src/builtins/system.rs +++ b/crates/foxvm/src/builtins/system.rs @@ -478,14 +478,43 @@ fn unique_token(width: usize) -> String { String::from_utf8(out).unwrap_or_default() } -/// SYS(): 3 and 2015 return unique names, 16 the running program, and everything else "" so a -/// program that queries the environment keeps running. +/// `SYS(2007, cText [, nSeed [, nFlags]])`: a checksum of the text, as a number written out. +/// Measured: CRC-16/CCITT (polynomial 0x1021) starting from 0xFFFF, or from nSeed when one other +/// than 0 or -1 is given; nFlags 1 is the standard CRC-32, which takes no seed. CodeMine's +/// SerialHash is built on it, so a serial number is only valid if this agrees with the product. +fn sys_checksum(a: &[Value]) -> Result { + let text = arg_str(a, 1)?; + let bytes: Vec = text.chars().map(|c| (c as u32 & 0xff) as u8).collect(); + let seed = opt_int(a, 2, -1)?; + if opt_int(a, 3, 0)? == 1 { + let mut crc: u32 = 0xFFFF_FFFF; + for b in &bytes { + crc ^= u32::from(*b); + for _ in 0..8 { + crc = if crc & 1 != 0 { (crc >> 1) ^ 0xEDB8_8320 } else { crc >> 1 }; + } + } + return Ok(Value::str((!crc).to_string())); + } + let mut crc: u16 = if seed == 0 || seed == -1 { 0xFFFF } else { seed as u16 }; + for b in &bytes { + crc ^= u16::from(*b) << 8; + for _ in 0..8 { + crc = if crc & 0x8000 != 0 { (crc << 1) ^ 0x1021 } else { crc << 1 }; + } + } + Ok(Value::str(crc.to_string())) +} + +/// SYS(): 3 and 2015 return unique names, 16 the running program, 2007 a checksum, and +/// everything else "" so a program that queries the environment keeps running. fn f_sys(c: &mut dyn BuiltinCtx, a: Vec) -> Result { let n = arg_int(&a, 0)?; ok(match n { 3 => Value::str(unique_token(8)), 2015 => Value::str(format!("_{}", unique_token(9))), 16 => Value::str(c.program_name()), + 2007 => sys_checksum(&a)?, // SYS(1271, oObject): the file a form was built from. Measured in vfp9.exe: it answers // .F. - a logical, not an empty string - for an object that came from no file, an // object of a class library included, and the Solution samples all test for that with diff --git a/crates/foxvm/src/bytecode.rs b/crates/foxvm/src/bytecode.rs index 2579168..b4b4c19 100644 --- a/crates/foxvm/src/bytecode.rs +++ b/crates/foxvm/src/bytecode.rs @@ -134,6 +134,11 @@ pub struct ClassProto { pub parent: String, /// Property values, constant-folded at compile time, in source order. pub properties: Vec<(String, Constant)>, + /// Property values that are expressions - `TxnDate = TRANSFORM(DTOS(DATE()), ...)` - as their + /// source text. Measured: Visual FoxPro works them out when an object is made, where the + /// program making it stands, so a variable set just before CREATEOBJECT() is seen. + #[serde(default)] + pub expressions: Vec<(String, String)>, pub members: Vec, /// `("Init", func)` / `("image1.Click", func)`: the name as written and the function index. pub methods: Vec<(String, u32)>, @@ -155,6 +160,9 @@ pub struct MemberProto { pub class: String, pub noinit: bool, pub properties: Vec<(String, Constant)>, + /// The WITH clause's values that are expressions, as source text; see [`ClassProto`]. + #[serde(default)] + pub expressions: Vec<(String, String)>, } impl Module { @@ -1078,11 +1086,13 @@ mod tests { ("Caption".into(), Constant::Str("Form1".into())), ("Visible".into(), Constant::Bool(true)), ], + expressions: vec![("Tag".into(), "DTOC(DATE())".into())], members: vec![MemberProto { name: "image1".into(), class: "image".into(), noinit: true, properties: vec![("Left".into(), Constant::num(100.0)), ("Picture".into(), Constant::Null)], + expressions: vec![], }], methods: vec![("Init".into(), 0)], }], diff --git a/crates/foxvm/src/compiler.rs b/crates/foxvm/src/compiler.rs index bb342dd..9b66ce9 100644 --- a/crates/foxvm/src/compiler.rs +++ b/crates/foxvm/src/compiler.rs @@ -54,6 +54,9 @@ impl CompileResult { } } +/// A class body's property values: the constants, and the expressions kept as source text. +type ClassValues = (Vec<(String, Constant)>, Vec<(String, String)>); + /// Compiles a .prg: `funcs[0]` is `MAIN`, the procedures follow in source order. pub fn compile_program(src: &str, name: &str) -> CompileResult { compile_program_with(src, name, &std::collections::HashMap::new()) @@ -637,16 +640,17 @@ impl ModuleCompiler { /// function named `"CLASSNAME.METHODNAME"` (`"CLASSNAME.MEMBER.EVENT"` for a member's), also /// listed in `Module::methods` so the host can start it by name. fn compile_class(&mut self, class: &ClassDecl) { - let properties = self.class_properties(&class.properties, &class.name.text); + let (properties, expressions) = self.class_properties(&class.properties, &class.name.text); let mut members = Vec::with_capacity(class.members.len()); for m in &class.members { let owner = format!("{}.{}", class.name.text, m.name.text); - let properties = self.class_properties(&m.properties, &owner); + let (properties, expressions) = self.class_properties(&m.properties, &owner); members.push(MemberProto { name: m.name.text.clone(), class: m.class.text.clone(), noinit: m.noinit, properties, + expressions, }); } let mut methods: Vec<(String, u32)> = Vec::new(); @@ -670,14 +674,18 @@ impl ModuleCompiler { name: class.name.text.clone(), parent: class.parent.text.clone(), properties, + expressions, members, methods, }); } - /// Folds every property value to a constant; a value VFP would not accept there is an error. - fn class_properties(&mut self, props: &[ClassProperty], owner: &str) -> Vec<(String, Constant)> { + /// Folds every property value it can to a constant. One that is an expression is kept as its + /// source text, for the host to work out when an object of the class is made - as Visual + /// FoxPro does, measured. + fn class_properties(&mut self, props: &[ClassProperty], owner: &str) -> ClassValues { let mut out = Vec::with_capacity(props.len()); + let mut expressions = Vec::new(); for p in props { // `DIMENSION aRGB[3]`: the property starts as an array of .F., as VFP creates it if let Some(dim) = &p.dim { @@ -692,15 +700,45 @@ impl ModuleCompiler { } continue; } + // an array the body dimensioned: `a[2] = x` sets that element, `a = x` sets every one - + // measured - rather than turning the array back into a single value + let array_at = out.iter().rposition(|(n, c): &(String, Constant)| n.eq_ignore_ascii_case(&p.name.text) && matches!(c, Constant::Array(_))); + if let Some(subs) = &p.index { + let (Some(at), Some(value), [sub]) = (array_at, fold_constant(&p.value), subs.as_slice()) else { + let msg = format!("{}[...] of '{}': only a constant in one element of a one-dimensional array is kept here", p.name.text, owner); + self.warning(p.name.span, msg); + continue; + }; + if let (Some(Constant::Num(n, ..)), Constant::Array(items)) = (fold_constant(sub), &mut out[at].1) + && n >= 1.0 + && (n as usize) <= items.len() + { + items[n as usize - 1] = value; + continue; + } + self.error(sub.span, format!("Subscript of '{}' of '{}' is outside the array", p.name.text, owner)); + continue; + } + if let (Some(at), Some(value)) = (array_at, fold_constant(&p.value)) { + if let Constant::Array(items) = &mut out[at].1 { + for item in items.iter_mut() { + *item = value.clone(); + } + } + continue; + } match fold_constant(&p.value) { Some(c) => out.push((p.name.text.clone(), c)), - None => { - let msg = format!("Property '{}' of '{}' must be set to a constant value", p.name.text, owner); - self.error(p.value.span, msg); - } + None => match self.src.get(p.value.span.start..p.value.span.end) { + Some(text) if !text.trim().is_empty() => expressions.push((p.name.text.clone(), text.trim().to_string())), + _ => { + let msg = format!("Property '{}' of '{}' must be set to a constant value", p.name.text, owner); + self.error(p.value.span, msg); + } + }, } } - out + (out, expressions) } // ----- statements ----- @@ -1094,11 +1132,11 @@ impl ModuleCompiler { } StmtKind::Set { setting, value } => { let argc = match value { - SetValue::On => { + SetValue::On | SetValue::Switch { on: true, .. } => { fb.emit(Instr::True); 1 } - SetValue::Off => { + SetValue::Off | SetValue::Switch { on: false, .. } => { fb.emit(Instr::False); 1 } @@ -1116,6 +1154,19 @@ impl ModuleCompiler { }; let n = self.name(&setting.upper); fb.emit(Instr::SetCmd { name: n, argc, to: matches!(value, SetValue::To(_)) }); + // `SET COMPATIBLE ON | OFF [PROMPT | NOPROMPT]`: the word is what SET("COMPATIBLE", 1) + // answers, and a switch with no word puts it back to PROMPT - measured. It goes where + // a setting keeps its second answer, which a TO form writes and an empty one clears. + // The words after any other switch - SET TALK OFF NOWINDOW - change nothing measured. + if setting.upper == "COMPATIBLE" { + let word = match value { + SetValue::Switch { words, .. } if words.trim().eq_ignore_ascii_case("NOPROMPT") => "NOPROMPT", + _ => "", + }; + let c = self.str_const(word); + fb.emit(Instr::Const(c)); + fb.emit(Instr::SetCmd { name: n, argc: 1, to: true }); + } } StmtKind::Try { body, catches, finally } => self.try_stmt(fb, body, catches, finally.as_ref()), StmtKind::Use { table, alias, exclusive, online, in_area, order, order_desc, indexes } => { diff --git a/crates/foxvm/src/host.rs b/crates/foxvm/src/host.rs index 67b457b..d859d5e 100644 --- a/crates/foxvm/src/host.rs +++ b/crates/foxvm/src/host.rs @@ -782,6 +782,10 @@ pub struct ClassDefOut { pub struct ClassPropOut { pub name: String, pub value: JsonValue, + /// The source of a value that is an expression, which the host works out when the object is + /// made; `value` is only a placeholder then. + #[serde(default, skip_serializing_if = "Option::is_none")] + pub expression: Option, } #[derive(Debug, Clone, PartialEq, Serialize, Deserialize)] @@ -807,7 +811,7 @@ impl ClassDefOut { ClassDefOut { name: proto.name.clone(), base_class: proto.parent.clone(), - properties: props_out(&proto.properties), + properties: props_out(&proto.properties, &proto.expressions), members: proto .members .iter() @@ -815,7 +819,7 @@ impl ClassDefOut { name: m.name.clone(), class: m.class.clone(), noinit: m.noinit, - properties: props_out(&m.properties), + properties: props_out(&m.properties, &m.expressions), }) .collect(), methods: proto @@ -828,8 +832,13 @@ impl ClassDefOut { } } -fn props_out(props: &[(String, crate::bytecode::Constant)]) -> Vec { - props.iter().map(|(name, c)| ClassPropOut { name: name.clone(), value: JsonValue::from_constant(c) }).collect() +fn props_out(props: &[(String, crate::bytecode::Constant)], expressions: &[(String, String)]) -> Vec { + let values = props.iter().map(|(name, c)| ClassPropOut { name: name.clone(), value: JsonValue::from_constant(c), expression: None }); + // an expression is worked out by the host when the object is made; until then it is .F. + let worked_out = expressions + .iter() + .map(|(name, text)| ClassPropOut { name: name.clone(), value: JsonValue::Bool(false), expression: Some(text.clone()) }); + values.chain(worked_out).collect() } /// Values crossing the bridge. Objects travel as handles; arrays by value; dates as ISO text diff --git a/crates/foxvm/src/parser.rs b/crates/foxvm/src/parser.rs index 2c0b0d2..8627c11 100644 --- a/crates/foxvm/src/parser.rs +++ b/crates/foxvm/src/parser.rs @@ -940,9 +940,30 @@ impl Parser { self.skip_line(); continue; }; + // `wbaSearchOrder[1] = "WIZARDS"`: one element of an array the body dimensioned + if self.is(&TokKind::LBracket) || self.is(&TokKind::LParen) { + let close = if self.is(&TokKind::LBracket) { TokKind::RBracket } else { TokKind::RParen }; + self.advance(); + let mut subs = Vec::new(); + while let Ok(e) = self.expr() { + subs.push(e); + if !self.eat(&TokKind::Comma) { + break; + } + } + if !self.eat(&close) || !self.eat(&TokKind::Eq) { + self.expected("'='"); + self.skip_line(); + continue; + } + let value = self.expr_or_recover(); + properties.push(ClassProperty { name: pname, value, dim: None, index: Some(subs) }); + self.end_of_line(); + continue; + } if self.eat(&TokKind::Eq) { let value = self.expr_or_recover(); - properties.push(ClassProperty { name: pname, value, dim: None }); + properties.push(ClassProperty { name: pname, value, dim: None, index: None }); self.end_of_line(); } else if restricted { // `PROTECTED a, b` declares properties without a value; VFP starts them at .F. @@ -958,7 +979,7 @@ impl Parser { } for n in names { let span = n.span; - properties.push(ClassProperty { name: n, value: Expr::new(ExprKind::Bool(false), span), dim: None }); + properties.push(ClassProperty { name: n, value: Expr::new(ExprKind::Bool(false), span), dim: None, index: None }); } self.end_of_line(); } else { @@ -999,7 +1020,7 @@ impl Parser { } let _ = self.eat(&TokKind::RBracket) || self.eat(&TokKind::RParen); } - out.push(ClassProperty { name, value: Expr::new(ExprKind::Bool(false), span), dim }); + out.push(ClassProperty { name, value: Expr::new(ExprKind::Bool(false), span), dim, index: None }); if !self.eat(&TokKind::Comma) { break; } @@ -1071,7 +1092,7 @@ impl Parser { break; } let value = self.expr_or_recover(); - properties.push(ClassProperty { name: pname, value, dim: None }); + properties.push(ClassProperty { name: pname, value, dim: None, index: None }); if !self.eat(&TokKind::Comma) { break; } @@ -6701,11 +6722,17 @@ impl Parser { let delimiters = !second_word.is_empty(); return self.set_textmerge_stmt(setting, delimiters); } - if self.eat_kw("ON") { - return Ok(StmtKind::Set { setting, value: SetValue::On }); - } - if self.eat_kw("OFF") { - return Ok(StmtKind::Set { setting, value: SetValue::Off }); + // A switch can have words after it - `SET COMPATIBLE OFF NOPROMPT`, `SET TALK OFF + // NOWINDOW` - which are kept for the setting to make of them. + for (word, on) in [("ON", true), ("OFF", false)] { + if self.eat_kw(word) { + if self.at_eol() { + return Ok(StmtKind::Set { setting, value: if on { SetValue::On } else { SetValue::Off } }); + } + let words = self.rest_of_line_text().unwrap_or_default(); + self.skip_line_keep_newline(); + return Ok(StmtKind::Set { setting, value: SetValue::Switch { on, words } }); + } } if self.eat_kw("TO") { if self.at_eol() { diff --git a/crates/foxvm/src/vm.rs b/crates/foxvm/src/vm.rs index d15b58c..d918cc1 100644 --- a/crates/foxvm/src/vm.rs +++ b/crates/foxvm/src/vm.rs @@ -2680,6 +2680,9 @@ impl Vm { let stack_len = fb.stack.len(); let handlers_len = fb.handlers.len(); let pending_len = fb.pending_rethrow.len(); + // a fiber asked to evaluate while it waits on the host - CREATEOBJECT() working out a + // property written as an expression - still wants its answer pushed when it resumes + let waiting = fb.pending.take(); self.push_inline(fb, id, false); let step = self.run(host, fb, floor); let r = match step { @@ -2693,7 +2696,7 @@ impl Vm { fb.stack.truncate(stack_len); fb.handlers.truncate(handlers_len); fb.pending_rethrow.truncate(pending_len); - fb.pending = None; + fb.pending = waiting; r } diff --git a/crates/foxvm/tests/classes.rs b/crates/foxvm/tests/classes.rs index f5e87af..dd5981e 100644 --- a/crates/foxvm/tests/classes.rs +++ b/crates/foxvm/tests/classes.rs @@ -240,26 +240,29 @@ fn property_values_are_constant_folded() { // ----- diagnostics --------------------------------------------------------------------------- #[test] -fn a_non_constant_property_value_is_an_error() { - let r = - compile_program("RETURN\nDEFINE CLASS c AS Custom\n Caption = MyFunc()\n Left = nStart\nENDDEFINE\n", "main"); - assert!(r.module.is_none()); +fn a_property_value_that_is_an_expression_is_kept_as_its_source() { + // Measured: Visual FoxPro works these out when an object is made, so the host is handed the + // text to evaluate then rather than a value folded now. + let r = compile_program( + "RETURN\nDEFINE CLASS c AS Custom\n Caption = TRANSFORM(DTOS(DATE()), \"@R xxxx-xx-xx\")\n Left = nStart + 1\n Top = 5\nENDDEFINE\n", + "main", + ); + let m = r.module.expect("compiles"); assert_eq!( - r.diagnostics.iter().filter(|d| d.is_error()).map(|d| d.message.clone()).collect::>(), + m.classes[0].expressions, vec![ - "Property 'Caption' of 'c' must be set to a constant value", - "Property 'Left' of 'c' must be set to a constant value" + ("Caption".to_string(), "TRANSFORM(DTOS(DATE()), \"@R xxxx-xx-xx\")".to_string()), + ("Left".to_string(), "nStart + 1".to_string()) ] ); + assert_eq!(m.classes[0].properties.len(), 1); let r = compile_program( "RETURN\nDEFINE CLASS c AS Custom\n ADD OBJECT img AS Image WITH Picture = GetPic()\nENDDEFINE\n", "main", ); - assert_eq!( - r.diagnostics.iter().filter(|d| d.is_error()).map(|d| d.message.clone()).collect::>(), - vec!["Property 'Picture' of 'c.img' must be set to a constant value"] - ); + let m = r.module.expect("compiles"); + assert_eq!(m.classes[0].members[0].expressions, vec![("Picture".to_string(), "GetPic()".to_string())]); } #[test] diff --git a/crates/foxvm/tests/common/mod.rs b/crates/foxvm/tests/common/mod.rs index 0a5e450..4c8cc1e 100644 --- a/crates/foxvm/tests/common/mod.rs +++ b/crates/foxvm/tests/common/mod.rs @@ -222,6 +222,7 @@ pub fn stmt(s: &Stmt) -> String { let v = match value { SetValue::On => "on".to_string(), SetValue::Off => "off".to_string(), + SetValue::Switch { on, words } => format!("{} {words}", if *on { "on" } else { "off" }), SetValue::To(e) => format!("(to {})", exprs(e)), SetValue::Word(w) => format!("(word \"{w}\")"), }; diff --git a/crates/foxvm/tests/programs/class_array_elements.expected b/crates/foxvm/tests/programs/class_array_elements.expected new file mode 100644 index 0000000..9f54f76 --- /dev/null +++ b/crates/foxvm/tests/programs/class_array_elements.expected @@ -0,0 +1,4 @@ +x x x +one 2 .F. L + 3 +WIZARDS APPDIR diff --git a/crates/foxvm/tests/programs/class_array_elements.prg b/crates/foxvm/tests/programs/class_array_elements.prg new file mode 100644 index 0000000..01a6fb7 --- /dev/null +++ b/crates/foxvm/tests/programs/class_array_elements.prg @@ -0,0 +1,18 @@ +* A class body can set every element of an array property, or one element of it +o = CREATEOBJECT("cx") +? o.aAll[1], o.aAll[2], o.aAll[3] +? o.aSome[1], o.aSome[2], o.aSome[3], VARTYPE(o.aSome[3]) +? ALEN(o.aSome) +? o.aOrder[1], o.aOrder[2], o.aOrder[3] + +DEFINE CLASS cx AS Custom + DIMENSION aAll[3] + DIMENSION aSome[3] + DIMENSION aOrder[3] + aAll = "x" + aSome[1] = "one" + aSome[2] = 2 + aOrder = "" + aOrder[1] = "WIZARDS" + aOrder(3) = "APPDIR" +ENDDEFINE diff --git a/crates/foxvm/tests/programs/set_switch_words.expected b/crates/foxvm/tests/programs/set_switch_words.expected new file mode 100644 index 0000000..4da9c2a --- /dev/null +++ b/crates/foxvm/tests/programs/set_switch_words.expected @@ -0,0 +1,5 @@ +OFF PROMPT +OFF NOPROMPT +OFF PROMPT +OFF PROMPT +OFF NOWINDOW diff --git a/crates/foxvm/tests/programs/set_switch_words.prg b/crates/foxvm/tests/programs/set_switch_words.prg new file mode 100644 index 0000000..fc6e373 --- /dev/null +++ b/crates/foxvm/tests/programs/set_switch_words.prg @@ -0,0 +1,11 @@ +* Words after a switch: SET COMPATIBLE's PROMPT or NOPROMPT is its second answer +? SET("COMPATIBLE"), SET("COMPATIBLE", 1) +SET COMPATIBLE OFF NOPROMPT +? SET("COMPATIBLE"), SET("COMPATIBLE", 1) +SET COMPATIBLE OFF PROMPT +? SET("COMPATIBLE"), SET("COMPATIBLE", 1) +SET COMPATIBLE OFF NOPROMPT +SET COMPATIBLE OFF +? SET("COMPATIBLE"), SET("COMPATIBLE", 1) +SET TALK OFF NOWINDOW +? SET("TALK"), SET("TALK", 1) diff --git a/crates/foxvm/tests/programs/sys_checksum.expected b/crates/foxvm/tests/programs/sys_checksum.expected new file mode 100644 index 0000000..8a5989d --- /dev/null +++ b/crates/foxvm/tests/programs/sys_checksum.expected @@ -0,0 +1,12 @@ +65535 +40311 +20810 +45780 +1023 +25123 +12883 +20810 +20810 +891568578 +891568578 + 5 C diff --git a/crates/foxvm/tests/programs/sys_checksum.prg b/crates/foxvm/tests/programs/sys_checksum.prg new file mode 100644 index 0000000..195b586 --- /dev/null +++ b/crates/foxvm/tests/programs/sys_checksum.prg @@ -0,0 +1,13 @@ +* SYS(2007): CRC-16 by default, from a seed when one is given, CRC-32 with flag 1 +? SYS(2007, "") +? SYS(2007, "a") +? SYS(2007, "abc") +? SYS(2007, "Hello, World") +? SYS(2007, REPLICATE("x", 300)) +? SYS(2007, "abc", 5) +? SYS(2007, "abc", 1234) +? SYS(2007, "abc", 0) +? SYS(2007, "abc", -1) +? SYS(2007, "abc", 0, 1) +? SYS(2007, "abc", 5, 1) +? LEN(SYS(2007, "abc")), VARTYPE(SYS(2007, "abc")) diff --git a/src/renderer/src/runtime/session.ts b/src/renderer/src/runtime/session.ts index d810041..5f45b48 100644 --- a/src/renderer/src/runtime/session.ts +++ b/src/renderer/src/runtime/session.ts @@ -1080,7 +1080,14 @@ export const useSessionStore = create((set, get) => { if (dot < 0) instance.classMethods.add(method.name.toLowerCase()); else instance.child(method.name.slice(0, dot))?.classMethods.add(method.name.slice(dot + 1).toLowerCase()); } - const created = await desktop.runFormLifecycle(instance, { noshow: true, args: request.args }); + const created = await desktop.runFormLifecycle(instance, { + noshow: true, + args: request.args, + // a property written as an expression is worked out now, where CREATEOBJECT() was + // called - measured: a variable set just before it is seen + expressions: built.expressions, + inFrame: (expression) => vm.evaluateIn(ctx.fiber, -1, expression), + }); if (!created) return null; return { $obj: instance.handle }; })(); diff --git a/src/shared/runtime/classDef.ts b/src/shared/runtime/classDef.ts index 58daa25..faaf97f 100644 --- a/src/shared/runtime/classDef.ts +++ b/src/shared/runtime/classDef.ts @@ -16,7 +16,18 @@ export interface VfpClassMember { /** `NOINIT`: do not run the member's Init when the container is created. */ noinit: boolean; /** Property values from the `WITH` clause, already constant-folded. */ - properties: { name: string; value: VmValue }[]; + properties: VfpClassProperty[]; +} + +/** + * One property a class body or a WITH clause sets. `expression` is there when the value was + * written as an expression rather than a constant: Visual FoxPro works it out when an object is + * made (measured), so `value` is only a placeholder until then. + */ +export interface VfpClassProperty { + name: string; + value: VmValue; + expression?: string; } export interface VfpClassDef { @@ -25,7 +36,7 @@ export interface VfpClassDef { /** What it inherits from: a VFP base class, or another class in the same program. */ baseClass: string; /** Class-level property assignments, in source order. */ - properties: { name: string; value: VmValue }[]; + properties: VfpClassProperty[]; /** Contained objects, in the order they were added. */ members: VfpClassMember[]; /** Methods this class defines. */ diff --git a/src/shared/runtime/classInstance.ts b/src/shared/runtime/classInstance.ts index 61d5b48..3467c14 100644 --- a/src/shared/runtime/classInstance.ts +++ b/src/shared/runtime/classInstance.ts @@ -27,6 +27,11 @@ export interface ClassArray { export interface BuiltClass { /** The node tree, shaped like a form so the desktop can instantiate it. */ form: FormNode; + /** + * Property values that are expressions, to work out once the object exists: keyed the way + * `workOutProperties` reads them, the class's own name first, then the member path. + */ + expressions: Record; /** True when the class has no visual representation and must not be shown. */ nonVisual: boolean; /** Array properties to declare on the live objects once the tree is instantiated. */ @@ -38,13 +43,14 @@ export interface BuiltClass { interface BuildContext { arrays: ClassArray[]; path: string[]; + expressions: Record; } /** Applies property entries to a node's sparse props, keeping VFP's case-insensitive names. */ function applyProperties( target: { name: string; props: Record; children?: ControlNode[] }, descriptor: ObjectDescriptor, - entries: readonly { name: string; value: VmValue }[], + entries: readonly { name: string; value: VmValue; expression?: string }[], ctx: BuildContext, ): void { // VFP allows a dotted path so a member of the object can be set from the same WITH list: @@ -57,6 +63,13 @@ function applyProperties( dotted.push(entry); continue; } + // worked out when the object is made; a later constant for the same property wins over it + const key = ['*', ...ctx.path, entry.name].join('.'); + if (entry.expression !== undefined) { + ctx.expressions[key] = entry.expression; + continue; + } + delete ctx.expressions[key]; // `DIMENSION aRGB[3]` arrives as an array value; a node's props hold only scalars, so it // is recorded and declared on the live object instead. if (isArray(entry.value)) { @@ -132,7 +145,7 @@ function applyToMember( ): void { const child = target.children?.find((c) => c.name.toLowerCase() === memberName.toLowerCase()); if (!child) return; - applyProperties(child, getDescriptor(child.type), [{ name: property, value }], { arrays: ctx.arrays, path: [...ctx.path, child.name] }); + applyProperties(child, getDescriptor(child.type), [{ name: property, value }], { ...ctx, path: [...ctx.path, child.name] }); } /** @@ -145,6 +158,7 @@ export function buildClassInstance(classes: readonly VfpClassDef[], className: s const warnings: ClassInstanceWarning[] = []; const arrays: ClassArray[] = []; + const expressions: Record = {}; const nonVisual = isNonVisualBaseClass(resolved.baseClass); const base = baseClassToControlType(resolved.baseClass); @@ -153,14 +167,14 @@ export function buildClassInstance(classes: readonly VfpClassDef[], className: s } const form: FormNode = { name: resolved.name, props: {}, methods: {}, children: [] }; - applyProperties(form, base === 'Form' || base === null ? FORM_DESCRIPTOR : getDescriptor(base), resolved.properties, { arrays, path: [] }); + applyProperties(form, base === 'Form' || base === null ? FORM_DESCRIPTOR : getDescriptor(base), resolved.properties, { arrays, path: [], expressions }); for (const member of resolved.members) { - const node = buildMember(classes, member, warnings, arrays, resolved.name, new Set([resolved.name.toLowerCase()])); + const node = buildMember(classes, member, warnings, arrays, expressions, resolved.name, new Set([resolved.name.toLowerCase()])); if (node) form.children.push(node); } - return { form, nonVisual: nonVisual || base === null, arrays, warnings }; + return { form, nonVisual: nonVisual || base === null, arrays, expressions, warnings }; } /** One `ADD OBJECT`, which may itself name a class defined in source. */ @@ -169,6 +183,7 @@ function buildMember( member: VfpClassDef['members'][number], warnings: ClassInstanceWarning[], arrays: ClassArray[], + expressions: Record, path: string, seen: ReadonlySet, ): ControlNode | null { @@ -187,7 +202,9 @@ function buildMember( } const node: ControlNode = { id: nanoid(8), type, name: member.name, props: { ...nested.form.props }, methods: {}, children: nested.form.children }; for (const a of nested.arrays) arrays.push({ ...a, path: [member.name, ...a.path] }); - applyProperties(node, getDescriptor(type), member.properties, { arrays, path: [member.name] }); + // the member's own class's expressions, under the member's name + for (const [key, source] of Object.entries(nested.expressions)) expressions[['*', member.name, ...key.split('.').slice(1)].join('.')] = source; + applyProperties(node, getDescriptor(type), member.properties, { arrays, path: [member.name], expressions }); return node; } } @@ -199,7 +216,7 @@ function buildMember( } const node: ControlNode = { id: nanoid(8), type, name: member.name, props: {}, methods: {}, children: [] }; - applyProperties(node, getDescriptor(type), member.properties, { arrays, path: [member.name] }); + applyProperties(node, getDescriptor(type), member.properties, { arrays, path: [member.name], expressions }); return node; } diff --git a/tests/runtime/classPropertyExpressions.test.ts b/tests/runtime/classPropertyExpressions.test.ts new file mode 100644 index 0000000..4a4bbbc --- /dev/null +++ b/tests/runtime/classPropertyExpressions.test.ts @@ -0,0 +1,55 @@ +import { beforeAll, beforeEach, describe, expect, it } from 'vitest'; +import { setApi } from '@renderer/api/foxdev'; +import { createMemoryApi } from '@renderer/api/memoryApi'; +import { useSessionStore } from '@renderer/runtime/session'; +import { createProjectSource } from '@renderer/runtime/projectSource'; +import { loadFoxVm } from '../../src/wasm/foxvm/loader'; + +const source = createProjectSource(); +const printed = () => + useSessionStore + .getState() + .output.filter((o) => o.kind === 'output') + .map((o) => o.text.replace(/\s+/g, ' ').trim()); + +beforeAll(async () => { + await loadFoxVm(); +}); + +beforeEach(() => { + setApi(createMemoryApi()); + useSessionStore.getState().cancel(); + useSessionStore.setState({ output: [] }); +}); + +// Measured in Visual FoxPro 9. +describe('a class property written as an expression', () => { + it('is worked out when the object is made, where CREATEOBJECT() was called', async () => { + // measured in Visual FoxPro 9; Shutter Ace's QuickBooksInvoice.TxnDate is the real case + await useSessionStore.getState().execute( + source, + [ + 'o = CREATEOBJECT("cx")', + '? "a", o.cDate == TRANSFORM(DTOS(DATE()),"@R xxxx-xx-xx"), o.nSum, VARTYPE(o.dWhen), o.dWhen == DATE(), o.cUp', + 'o3 = CREATEOBJECT("cchild")', + '? "c", o3.nSum, o3.cDate == o.cDate', + 'nBase = 7', + 'o4 = CREATEOBJECT("cvar")', + '? "d", VARTYPE(o4), o4.nFromVar', + 'DEFINE CLASS cx AS Custom', + ' cDate = TRANSFORM(DTOS(DATE()),"@R xxxx-xx-xx")', + ' nSum = 2 + 3', + ' dWhen = DATE()', + ' cUp = UPPER("abc")', + 'ENDDEFINE', + 'DEFINE CLASS cchild AS cx', + ' nSum = 10 * 2', + 'ENDDEFINE', + 'DEFINE CLASS cvar AS Custom', + ' nFromVar = nBase + 1', + 'ENDDEFINE', + ].join('\n'), + ); + expect(printed()).toEqual(['a .T. 5 D .T. ABC', 'c 20 .T.', 'd O 8']); + }); +});