admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reorganize source tree: kernel/, v3/, v4/ split and board infrastructure

Browse Source 
Source tree reorganization:
- Move StarForth v3 engine to v3/ (src/, include/, Makefile)
- Move kernel to kernel/ (src/, include/, linker/, Makefile)
- Create v4/ skeleton for F18-ISA golden model (DECOMPOSITION.md, JUSTIFICATION.md)
- Move FABRIC-0..4.md to docs/fabric/
- Move ONTOLOGY.md and ROADMAP.md to docs/

Board infrastructure:
- Add boards/ser5/, boards/raspi/, boards/milkv/, boards/zynq7020/
- Each board has board.mk (ISA, CPU flags, boot recipe) and README.md
- Root Makefile becomes thin dispatcher: boot_image, all, clean, docs take TARGET
- make boot_image TARGET=SER5|RASPI|MILKV builds one GPT/MBR image per board
- ZYNQ7020 target exists but stops with clear error (ARMv7 port not built yet)
- scripts/mkdiskimage.sh builds disk images for all boards

Docs pipeline:
- docs/book/ with LaTeX master (main.tex) and Makefile
- pandoc converts Markdown to LaTeX at build time
- Two Lua filters: table-widths.lua (wide tables wrap), code-breaks.lua (inline code breaks)
- make docs builds single PDF (754 pages, 0 missing characters)
- make docs TARGET=<board> adds board appendix
- build/docs/<book|board>/meta.tex stamps git commit into PDF

Bug fixes:
- 42 include paths that only worked by accident now use correct relative paths
- clang-18 hardcode replaced with configurable CC variable (fixed aarch64 build)
- Pi 5: kernel_2712.img linked at 0x80000, .bss zeroed, memory reserved
- Doxyfile, .clang-tidy, README.md, Kconfig paths updated

Verified:
- Hosted v3 build passes 1012 tests, 0 failures
- SER5 image boots in QEMU (OVMF), POST passes, K exact (65536 = Q48_ONE)
- Milk-V image boots in QEMU (OpenSBI + U-Boot + bootefi), POST passes
- make clean TARGET=<board> removes only that board and its ISA objects
- make all builds all boards, hosted v3, and docs in one run

Co-authored-by: Junie <junie@jetbrains.com>
This commit is contained in:
rajames
2026-10-01 15:40:09 -04:00
co-authored by Junie
parent 3c709c115b
commit a8b70e88d3
630 changed files with 2646 additions and 2036 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v3/src/test_runner/README.md
+17
View File
@@ -0,0 +1,17 @@
# src/test_runner/
Test harness for the hosted VM's test suite, run via
`./starforth --run-tests`. Organized in POST (Power-On Self Test) order:
unit tests → dictionary/word-category tests → integration/stress/
adversarial tests.
- `test_runner.c` — test harness orchestration (loads and runs all
modules in POST order).
- `test_common.c` — shared test utilities.
- `test_contracts.c` — contract-based testing infrastructure (pre/post
condition assertions around word execution).
Subdirectories:
- `include/` — public headers for this harness.
- `modules/` — per-category test files; see
`src/test_runner/modules/README.md`.
v3/src/test_runner/include/README.md
+8
View File
@@ -0,0 +1,8 @@
# src/test_runner/include/
Public headers for the test harness.
- `test_runner.h` — harness orchestration interface.
- `test_common.h` — shared test utility declarations.
- `test_contracts.h` — contract-based testing (pre/post-condition
assertion) interface.
v3/src/test_runner/include/test_common.h
+214
View File
@@ -0,0 +1,214 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/**
* @file test_common.h
* @brief Common test utilities and structures for StarForth test runner
* @details This file contains test configuration, structures, and utility functions
* used throughout the StarForth test framework.
*/
#ifndef TEST_COMMON_H
#define TEST_COMMON_H
#include "../../../include/vm.h"
#include "../../../include/log.h"
#include "test_contracts.h"
/** @name Test Configuration
* @{
*/
/** Maximum length of test output buffer */
#define MAX_TEST_OUTPUT 1024
/** Maximum length of test input buffer */
#define MAX_TEST_INPUT 256
/** Maximum number of test cases per word */
#define MAX_TESTS_PER_WORD 20
/** @} */
/* fail fast */
extern int fail_fast;
/** @brief Types of test cases */
typedef enum {
TEST_NORMAL = 0, /**< Standard test case */
TEST_EDGE_CASE = 1, /**< Edge case test */
TEST_ERROR_CASE = 2 /**< Error condition test */
} TestType;
/** @brief Structure representing a single test case */
typedef struct {
const char *name; /**< Name of the test case */
const char *input; /**< Input Forth code */
const char *expected; /**< Expected output */
TestType type; /**< Type of test case */
int should_error; /**< Whether test should produce an error */
int implemented; /**< Whether the functionality is implemented */
WordContract contract; /**< Per-test contract override; zero = inherit from suite/module */
} TestCase;
/** @brief Collection of test cases for a single Forth word */
typedef struct {
const char *word_name; /**< Name of the Forth word being tested */
TestCase tests[MAX_TESTS_PER_WORD]; /**< Array of test cases */
int test_count; /**< Number of tests in the suite */
WordContract suite_contract; /**< Suite-level contract; zero = inherit from module */
} WordTestSuite;
/** @name Core Test Execution Functions
* @{
*/
/*
* @brief Executes a single test case
* @param vm Pointer to the VM instance
* @param word_name Name of the word being tested
* @param test Test case to execute
* @return Test execution result
*/
TestResult run_single_test(VM *vm, const char *word_name, const TestCase *test);
/*
* @brief Runs all tests in a test suite
* @param vm Pointer to the VM instance
* @param suite Test suite to execute
*/
void run_test_suite(VM *vm, const WordTestSuite *suite);
/**
* @brief Runs all tests in a suite with an inherited module-level contract.
*
* Contract resolution order (first non-NONE wins):
* test->contract > suite->suite_contract > module_contract
*
* When CONTRACTS_ENABLED=1, each passing TEST_NORMAL test is re-run under
* physics perturbation to witness A4' (word_physics_transparent).
*
* @param vm Pointer to the VM instance
* @param suite Test suite to execute
* @param module_contract Default contract for tests that don't specify one
*/
void run_test_suite_m(VM *vm, const WordTestSuite *suite, WordContract module_contract);
/*
* @brief Prints test results_run_01_2025_12_08 summary for a module
* @param module_name Name of the module
* @param pass Number of passed tests
* @param fail Number of failed tests
* @param skip Number of skipped tests
* @param error Number of errors
*/
void print_module_summary(const char *module_name, int pass, int fail, int skip, int error);
/** @} */
/** @name Test Assertion Functions
* @{
*/
/*
* @brief Verifies the VM stack depth
* @param vm Pointer to the VM instance
* @param expected_depth Expected stack depth
* @return 1 if assertion passes, 0 otherwise
*/
int assert_stack_depth(VM *vm, int expected_depth);
/*
* @brief Verifies the value at the top of the stack
* @param vm Pointer to the VM instance
* @param expected_value Expected value
* @return 1 if assertion passes, 0 otherwise
*/
int assert_stack_top(VM *vm, int expected_value);
/*
* @brief Verifies VM error state
* @param vm Pointer to the VM instance
* @param should_have_error Expected error state
* @return 1 if assertion passes, 0 otherwise
*/
int assert_vm_error(VM *vm, int should_have_error);
/** @} */
/** @name VM State Management Functions
* @{
*/
/*
* @brief Saves current VM state
* @param vm Pointer to the VM instance
* @param dsp Pointer to store data stack pointer
* @param rsp Pointer to store return stack pointer
* @param error Pointer to store error state
* @param mode Pointer to store VM mode
*/
void save_vm_state(VM *vm, int *dsp, int *rsp, int *error, vm_mode_t *mode);
/*
* @brief Restores VM state from saved values
* @param vm Pointer to the VM instance
* @param dsp Data stack pointer to restore
* @param rsp Return stack pointer to restore
* @param error Error state to restore
* @param mode VM mode to restore
*/
void restore_vm_state(VM *vm, int dsp, int rsp, int error, vm_mode_t mode);
/*
* @brief Saves dictionary state before test execution
* @param vm Pointer to VM instance
* @param latest Pointer to store latest dictionary entry
* @param here Pointer to store HERE pointer
*/
void save_dict_state(VM * vm, DictEntry * *latest, size_t * here);
/*
* @brief Restores dictionary state after test execution
* @param vm Pointer to VM instance
* @param latest Latest dictionary entry to restore
* @param here HERE pointer to restore
* @details Removes all words added during test by restoring dictionary pointers
*/
void restore_dict_state(VM *vm, DictEntry *latest, size_t here);
/** @} */
#endif /* TEST_COMMON_H */
v3/src/test_runner/include/test_contracts.h
+121
View File
@@ -0,0 +1,121 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
Licensed under the Starship License 1.0 (SL-1.0)
*/
#ifndef TEST_CONTRACTS_H
#define TEST_CONTRACTS_H
#include "vm.h" /* resolved via -Iinclude */
#include <stdint.h>
#include <stddef.h>
/* ============================================================================
* Word Contract System — Runtime witnesses for Isabelle/HOL axioms
*
* Two axioms require runtime verification:
* A1 heartbeat_exec_neutral — vm_tick() must not write exec-equiv fields
* A4' word_physics_transparent — word results must be independent of physics state
*
* Contracts attach at three levels; resolution order (first non-NONE wins):
* individual TestCase > WordTestSuite.suite_contract > module_contract arg
*
* Contract checks run unconditionally as part of POST.
* ============================================================================ */
typedef uint32_t contract_flags_t;
#define CONTRACT_NONE 0u
/* A4': re-run word with perturbed physics; assert identical exec result */
#define CONTRACT_PHYSICS_TRANSPARENT (1u << 0)
/* A1: call vm_tick() and assert exec-equiv fields are unchanged */
#define CONTRACT_HEARTBEAT_SAFE (1u << 1)
/* Number of physics perturbation rounds per test case (0 = use default) */
#define CONTRACT_DEFAULT_FUZZ_ROUNDS 4
typedef struct {
contract_flags_t flags;
int fuzz_rounds; /* 0 = use CONTRACT_DEFAULT_FUZZ_ROUNDS */
} WordContract;
/* Exec-domain snapshot — exactly the four fields in exec_equiv */
typedef struct {
cell_t stack[STACK_SIZE];
int dsp;
int rsp;
int error;
} ExecResult;
/* Physics field snapshot for save/restore around A4' checks */
typedef struct {
uint64_t decay_slope_q48;
uint32_t eff_window_size;
uint64_t tick_target_ns;
cell_t heat_25th;
cell_t heat_50th;
cell_t heat_75th;
uint64_t prefetch_attempts;
uint64_t total_executions;
} PhysicsSnapshot;
/* Global counter incremented on each contract violation (CONTRACTS_ENABLED only) */
extern int global_contract_violations;
/*
* Accessor functions for global_contract_violations.
* Use these from other TUs — direct extern access generates GOTPCRELX which
* the PE linker does not relax, causing double-dereference bugs in -fPIC PE builds.
*/
int contract_get_violation_count(void);
void contract_reset_violation_count(void);
/*
* capture_exec_result — snapshot the four exec-equiv fields from vm into r.
*/
void capture_exec_result(VM *vm, ExecResult *r);
/*
* exec_results_equal — 1 if a and b agree on dsp, rsp, error, and live stack.
*/
int exec_results_equal(const ExecResult *a, const ExecResult *b);
/*
* save_physics / restore_physics — snapshot and restore key physics scalars.
*/
void save_physics(VM *vm, PhysicsSnapshot *s);
void restore_physics(VM *vm, const PhysicsSnapshot *s);
/*
* perturb_physics — replace key physics scalars with fresh random values.
* round is used to vary the RNG seed across multiple rounds.
*/
void perturb_physics(VM *vm, int round);
/*
* check_physics_transparent — A4' contract check for a single test case.
*
* Runs input with the current physics state (baseline), then runs it again
* fuzz_rounds times with physics perturbed, asserting identical ExecResult
* each time. Returns 1 if all rounds match, 0 on first violation (which is
* also logged as an error). Skips error-expected and unimplemented tests.
*
* NOTE: input must not define dictionary words; the dict is not snapshotted
* inside this function. Callers that cover defining-words tests should
* save/restore dict state around this call.
*/
int check_physics_transparent(VM *vm, const char *word_name,
const char *input,
int should_error, int implemented,
int fuzz_rounds);
/*
* assert_heartbeat_safe — A1 contract check.
*
* Snapshots exec-equiv fields, calls vm_tick(), then asserts all four fields
* are unchanged. Returns 1 if the assertion holds, 0 on violation.
*/
int assert_heartbeat_safe(VM *vm);
#endif /* TEST_CONTRACTS_H */
v3/src/test_runner/include/test_runner.h
+181
View File
@@ -0,0 +1,181 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#ifndef TEST_RUNNER_H
#define TEST_RUNNER_H
#include "../../../include/vm.h"
#include <stdint.h>
/**
* @brief Structure holding test execution statistics
*/
typedef struct {
int total_tests; /**< Total number of tests executed */
int total_pass; /**< Number of passed tests */
int total_fail; /**< Number of failed tests */
int total_skip; /**< Number of skipped tests */
int total_error; /**< Number of tests that resulted in errors */
} TestStats;
/**
* @brief Structure representing a test module
*/
typedef struct {
const char *module_name; /**< Name of the test module */
void *reserved; /**< Reserved for future use */
int reserved_int; /**< Reserved integer value */
void (*run_module_tests)(VM *vm); /**< Function pointer to run module tests */
} TestModule;
/* Global test statistics - extern declaration */
extern TestStats global_test_stats;
/*
* Same-TU accumulator — use instead of direct struct access from other TUs.
* Direct extern struct access generates R_X86_64_REX_GOTPCRELX which the
* PE linker does not relax, causing double-dereference in -fPIC PE builds.
*/
void test_stats_accumulate(int tests, int pass, int fail, int skip, int error);
/*
* @brief Run tests for stack manipulation words
* @param vm Pointer to the VM instance
*/
void run_stack_words_tests(VM * vm);
void run_return_stack_words_tests(VM * vm);
void run_memory_words_tests(VM * vm);
void run_arithmetic_words_tests(VM * vm);
void run_logical_words_tests(VM * vm);
void run_mixed_arithmetic_words_tests(VM * vm);
void run_double_words_tests(VM * vm);
void run_dictionary_words_tests(VM * vm);
void run_io_words_tests(VM * vm);
void run_format_words_tests(VM * vm);
void run_string_words_tests(VM * vm);
void run_dictionary_manipulation_words_tests(VM * vm);
void run_vocabulary_words_tests(VM * vm);
void run_block_words_tests(VM * vm);
void run_system_words_tests(VM * vm);
void run_defining_words_tests(VM * vm);
void run_control_words_tests(VM * vm);
void run_starforth_words_tests(VM * vm);
void run_acl_words_tests(VM * vm);
/*
* @brief Run tests for Q48.16 fixed-point words (Module 25)
* @param vm Pointer to the VM instance
*/
void run_q48_words_tests(VM * vm);
/*
* @brief Run tests for the proof-covered subset of inference-engine words (Module 26)
* @param vm Pointer to the VM instance
*/
void run_inference_words_tests(VM * vm);
/*
* @brief Run tests for the proof-covered subset of physics-freeze words (Module 27)
* @param vm Pointer to the VM instance
*/
void run_physics_freeze_words_tests(VM * vm);
/*
* @brief Run tests for Mama FORTH vocabulary (capsule system M7.1)
* @param vm Pointer to the VM instance
*
* In hosted builds, all tests are skipped (Mama words are kernel-only).
* In kernel builds, tests validate capsule enumeration and VM birth.
*/
void run_mama_forth_words_tests(VM * vm);
/*
* @brief Enable benchmark mode for performance testing
* @param iterations Number of iterations for benchmark tests
*/
void enable_benchmark_mode(int iterations);
/*
* @brief Execute stress tests
* @param vm Pointer to the VM instance
*/
void run_stress_tests(VM * vm);
/*
* @brief Execute integration tests
* @param vm Pointer to the VM instance
*/
void run_integration_tests(VM * vm);
/*
* @brief Run all available tests
* @param vm Pointer to the VM instance
*/
void run_all_tests(VM * vm);
/*
* @brief Run tests for a specific module
* @param vm Pointer to the VM instance
* @param module_name Name of the module to test
*/
void run_module_tests(VM *vm, const char *module_name);
/*
* @brief Run tests for a specific word
* @param vm Pointer to the VM instance
* @param word_name Name of the word to test
*/
void run_word_tests(VM *vm, const char *word_name);
/**
* @brief Run ultra-comprehensive break-me diagnostic suite
* @param vm Pointer to the VM instance
*
* Executes the most exhaustive test battery ever designed for StarForth,
* generates a detailed markdown report in docs/BREAK_ME_REPORT.md,
* and includes a surprise easter egg at the end.
*/
void run_break_me_tests(VM * vm);
#endif /* TEST_RUNNER_H */
v3/src/test_runner/modules/README.md
+26
View File
@@ -0,0 +1,26 @@
# src/test_runner/modules/
Per-category test files, one per FORTH-79 word category plus
integration/stress/adversarial suites, run in this order by
`test_runner.c` (POST order).
**Word-category tests** (validate each `src/word_source/*.c` file):
`arithmetic_words_test.c`, `mixed_arithmetic_words_test.c`,
`stack_words_test.c`, `control_words_test.c`, `defining_words_tests.c`,
`memory_words_test.c`, `return_stack_words_test.c`, `double_words_test.c`,
`logical_words_test.c`, `io_words_test.c`, `string_words_test.c`,
`block_words_test.c`, `format_words_test.c`, `system_words_test.c`,
`dictionary_words_test.c`, `dictionary_manipulation_words_test.c`,
`vocabulary_words_test.c`, `starforth_words_test.c`,
`mama_forth_words_test.c`, `acl_words_test.c`.
**Cross-cutting tests**:
- `integration_tests.c` — multi-word interaction tests.
- `stress_tests.c` — load/volume tests.
- `break_me_tests.c` — adversarial/fuzzing tests.
Note: not every `src/word_source/*.c` file has a dedicated test module
here (e.g. `defer_words.c`, `log_words.c`, `inference_words.c`,
`lifecycle_words_hosted.c`, `editor_words.c` are exercised indirectly via
integration tests or the `tools/hermes_*.sh` smoke tests rather than a
standalone `*_test.c` module).
v3/src/test_runner/modules/acl_words_test.c
+628
View File
@@ -0,0 +1,628 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/*
* acl_words_test.c — POST tests for the word-level ACL system (Module 24)
*
* Tests directly manipulate DictEntry ACL fields in C and then verify
* behaviour through the interpreter or via direct field inspection.
* This avoids depending on ACL.4th being loaded during POST.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
#include "../../../include/vm.h"
#include "../../word_source/include/acl_words.h"
#include <stdio.h>
/* ------------------------------------------------------------------ */
static int tests_passed = 0;
static int tests_failed = 0;
#define ACL_ASSERT(cond, msg) \
do { \
if (cond) { \
tests_passed++; \
log_message(LOG_DEBUG, " PASS: %s", msg); \
} else { \
tests_failed++; \
log_message(LOG_ERROR, " FAIL: %s", msg); \
} \
} while (0)
/* ------------------------------------------------------------------ */
/**
* @brief Test 1 — ACL-PIN is a one-way ratchet.
*
* Creates a temporary word and pins it via @c ACL-PIN. Verifies that
* subsequent calls to @c ACL-MODE!, @c ACL-TTL!, and @c ACL-ALLOW! are
* all no-ops while the word is pinned. The pin flag itself must remain 1.
*
* Expected assertions (4):
* - @c acl_pinned == 1 after ACL-PIN
* - @c acl_mode unchanged after ACL-MODE! on pinned entry
* - @c acl_ttl unchanged after ACL-TTL! on pinned entry
* - @c acl_allow unchanged after ACL-ALLOW! on pinned entry
*
* @param vm VM instance (shared state; caller restores after this function).
*/
static void test_acl_pin_immutable(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_pin_test__", 16, NULL);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_TTL;
e->acl_pinned = 0;
/* Pin it */
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-PIN");
vm->error = 0;
ACL_ASSERT(e->acl_pinned == 1, "ACL-PIN sets acl_pinned=1");
/* Attempt to change mode via ACL-MODE! (C primitive) — should be no-op when pinned */
vm_push(vm, (cell_t)ACL_MODE_STRICT);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-MODE!");
vm->error = 0;
ACL_ASSERT(e->acl_mode == ACL_MODE_TTL, "ACL-STRICT is no-op when pinned");
/* Attempt to change TTL — should be ignored */
uint32_t old_ttl = e->acl_ttl;
vm_push(vm, (cell_t)9999);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL!");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == old_ttl, "ACL-TTL! is no-op when pinned");
/* Attempt to change allow — should be ignored */
e->acl_allow = 1;
vm_push(vm, (cell_t)0);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-ALLOW!");
vm->error = 0;
ACL_ASSERT(e->acl_allow == 1, "ACL-ALLOW! is no-op when pinned");
}
/**
* @brief Test 2 — ACL-INHERIT copies mode, clears pin, and resets TTL/allow.
*
* Constructs a source entry with STRICT mode, pinned, TTL=5000, allow=0,
* and a destination entry with a different mode and also pinned. Calls
* @c acl_inherit_entry() directly and checks the resulting destination
* state. Verifies the Isabelle/HOL lemma @c ACL_Inherit_Clears_Pin.
*
* Expected assertions (4):
* - @c dst->acl_mode == ACL_MODE_STRICT (mode copied from src)
* - @c dst->acl_pinned == 0 (pin cleared regardless of dst's original pin)
* - @c dst->acl_ttl == 0 (TTL reset to 0)
* - @c dst->acl_allow == 1 (allow reset to 1)
*
* @param vm VM instance (used for word creation; not modified beyond that).
*/
static void test_acl_inherit(VM *vm)
{
DictEntry *src = vm_create_word(vm, "__acl_src__", 11, NULL);
DictEntry *dst = vm_create_word(vm, "__acl_dst__", 11, NULL);
if (!src || !dst) { tests_failed++; return; }
src->acl_mode = ACL_MODE_STRICT;
src->acl_pinned = 1;
src->acl_ttl = 5000;
src->acl_allow = 0;
dst->acl_pinned = 1; /* even a pinned dst should be cleared */
dst->acl_mode = ACL_MODE_TTL;
acl_inherit_entry(src, dst);
ACL_ASSERT(dst->acl_mode == ACL_MODE_STRICT, "ACL-INHERIT copies acl_mode");
ACL_ASSERT(dst->acl_pinned == 0, "ACL-INHERIT clears acl_pinned");
ACL_ASSERT(dst->acl_ttl == 0, "ACL-INHERIT resets acl_ttl to 0");
ACL_ASSERT(dst->acl_allow == 1, "ACL-INHERIT resets acl_allow to 1");
}
/**
* @brief Test 3 — emergency_console flag bypasses a denied word.
*
* Defines a FORTH word that pushes 42, then sets its @c acl_allow to 0
* to simulate a policy denial. Executes the word with @c emergency_console=1
* and verifies that the word body ran (stack depth increased by 1).
*
* The @c emergency_console bypass is required by the bare-metal fault
* handler so that critical recovery words can always execute.
*
* Expected assertions (1):
* - @c vm->dsp == saved_dsp + 1 (word ran despite deny)
*
* @param vm VM instance.
*/
static void test_emergency_console_bypass(VM *vm)
{
/* Define a simple FORTH word that pushes a marker */
vm_interpret(vm, ": __acl_ec_test__ 42 ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_ec_test__", 15);
if (!e) { tests_failed++; return; }
/* Deny it */
e->acl_allow = 0;
e->acl_ttl = 0;
e->acl_pinned = 0;
/* With emergency_console=1: should execute despite deny */
int saved_dsp = vm->dsp;
vm->emergency_console = 1;
vm_interpret(vm, "__acl_ec_test__");
vm->emergency_console = 0;
vm->error = 0;
ACL_ASSERT(vm->dsp == saved_dsp + 1, "emergency_console bypasses ACL deny");
if (vm->dsp > saved_dsp) vm->dsp--; /* pop the 42 */
/* Restore allow so subsequent tests don't trip over it */
e->acl_allow = 1;
}
/**
* @brief Test 4 — ACL denial aborts execution without running the word body.
*
* Defines a word that pushes a sentinel (99), then denies it with
* @c acl_allow=0 and @c acl_ttl=1 (hot-path decrement triggers the deny
* check without invoking @c acl_recheck()). Verifies that executing the
* word sets either @c vm->abort_requested, @c vm->error, or leaves the
* stack depth unchanged — and that the sentinel was never pushed.
*
* @c acl_ttl=1 is used rather than 0 to stay on the hot path (TTL
* decrements to 0 → check; avoids the fail-open cold-path recheck).
*
* Expected assertions (2):
* - Execution was aborted (abort_requested || error || stack unchanged)
* - Stack depth is unchanged (sentinel was not pushed)
*
* @param vm VM instance.
*/
static void test_acl_deny_aborts(VM *vm)
{
/* Define a word that pushes a sentinel value */
vm_interpret(vm, ": __acl_deny_test__ 99 ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_deny_test__", 17);
if (!e) { tests_failed++; return; }
e->acl_allow = 0;
e->acl_ttl = 1; /* hot path: decrement then check; avoids fail-open recheck */
e->acl_pinned = 0;
int saved_dsp = vm->dsp;
vm->emergency_console = 0;
vm_interpret(vm, "__acl_deny_test__");
int was_aborted = (vm->abort_requested || vm->error || vm->dsp == saved_dsp);
vm->abort_requested = 0;
vm->error = 0;
ACL_ASSERT(was_aborted, "denied word triggers abort");
ACL_ASSERT(vm->dsp == saved_dsp, "denied word: stack unchanged");
e->acl_allow = 1;
}
/**
* @brief Test 5 — ACL TTL hot-path decrements without invoking recheck.
*
* Defines a word with @c acl_ttl=10 and @c acl_allow=1, then executes
* it three times via the outer interpreter. Each outer-interpreter
* execution decrements @c acl_ttl by 1, so the expected final value is 7.
*
* This confirms the hot-path optimisation: the interpreter only calls
* @c acl_recheck() when @c acl_ttl reaches 0, not on every invocation.
*
* Expected assertions (1):
* - @c e->acl_ttl == 7 after three executions (10 → 9 → 8 → 7)
*
* @param vm VM instance.
*/
static void test_acl_ttl_hot_path(VM *vm)
{
vm_interpret(vm, ": __acl_ttl_test__ 1 DROP ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_ttl_test__", 16);
if (!e) { tests_failed++; return; }
e->acl_allow = 1;
e->acl_ttl = 10;
e->acl_pinned = 0;
e->acl_mode = ACL_MODE_TTL;
/* Execute the word 3 times via the outer interpreter */
vm->emergency_console = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == 7, "TTL hot path: TTL decrements from 10 to 7 after 3 execs");
}
/**
* @brief Test 6 — STRICT mode keeps TTL at 0 after every recheck.
*
* In @c ACL_MODE_STRICT, @c ACL-RECHECK must reset @c acl_ttl to 0 after
* each allow decision so the recheck fires on every subsequent execution.
*
* If @c ACL.4th is not loaded, @c ACL-RECHECK is absent and @c acl_recheck()
* fails open (@c acl_ttl = @c ACL_TTL_OPEN). In that case the test is
* conditionally skipped (counted as a pass) since the ACL system is not
* yet active.
*
* Expected assertions (1, or skip counted as 1 pass):
* - @c e->acl_ttl == 0 after one execution in STRICT mode with ACL loaded.
*
* @param vm VM instance.
*/
static void test_acl_strict_mode(VM *vm)
{
vm_interpret(vm, ": __acl_strict_test__ DROP ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_strict_test__", 19);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_STRICT;
e->acl_allow = 1;
e->acl_ttl = 0;
e->acl_pinned = 0;
/* ACL-RECHECK for STRICT mode must reset TTL to 0 after allowing */
vm_push(vm, (cell_t)(uintptr_t)e);
DictEntry *recheck = vm_find_word(vm, "ACL-RECHECK", 11);
if (recheck) {
/* ACL-RECHECK is not yet in the dict (ACL.4th not loaded) — skip FORTH call */
/* Test via acl_recheck() directly: in STRICT mode, TTL stays 0 */
/* We can't call acl_recheck() directly (static), but we can test
that the vm_interpret path triggers the recheck path correctly.
After execution with TTL=0 and allow=1, TTL should still be 0
in STRICT mode (recheck was called and set TTL=0 again). */
vm->dsp--; /* clean up the push above */
vm_interpret(vm, "0 __acl_strict_test__");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == 0, "STRICT mode: TTL remains 0 after recheck");
} else {
/* ACL.4th not loaded yet — fallback sets TTL=OPEN; note but don't fail */
vm->dsp--;
log_message(LOG_INFO, " SKIP: STRICT mode test (ACL.4th not loaded)");
tests_passed++; /* conditional skip counts as pass in POST */
}
}
/**
* @brief Test 7 — Adaptive TTL scales with execution heat via ACL-TTL-COMPUTE.
*
* Sets @c execution_heat=2560 on a temporary entry and invokes
* @c ACL-TTL-COMPUTE if the word is present (i.e., @c ACL.4th is loaded).
* The expected formula is @c ttl = heat/4 + 256 = 640 + 256 = 896.
*
* If @c ACL-TTL-COMPUTE is not present (ACL.4th not yet loaded), the test
* is conditionally skipped and counted as a pass.
*
* Expected assertions (1, or skip):
* - @c ACL-TTL-COMPUTE returns 896 for heat=2560.
*
* @param vm VM instance.
*/
static void test_acl_adaptive_ttl(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_heat_test__", 17, NULL);
if (!e) { tests_failed++; return; }
/* Set heat and verify TTL-COMPUTE via FORTH (if ACL.4th loaded) */
e->execution_heat = 2560;
e->acl_allow = 1;
e->acl_pinned = 0;
DictEntry *ttl_compute = vm_find_word(vm, "ACL-TTL-COMPUTE", 15);
if (ttl_compute) {
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL-COMPUTE");
vm->error = 0;
if (vm->dsp >= 0) {
cell_t ttl = vm_pop(vm);
/* heat=2560, ttl = 2560/4 + 256 = 640+256 = 896 */
ACL_ASSERT(ttl == 896, "ACL-TTL-COMPUTE: heat=2560 → ttl=896");
} else {
tests_failed++;
log_message(LOG_ERROR, " FAIL: ACL-TTL-COMPUTE left empty stack");
}
} else {
log_message(LOG_INFO, " SKIP: ACL-TTL-COMPUTE (ACL.4th not loaded)");
tests_passed++;
}
vm->error = 0;
}
/**
* @brief Test 8 — A pinned word cannot be shadowed by redefinition.
*
* Creates a word, pins it, then attempts to create another word with
* the same name via @c vm_create_word(). Verifies that the second create
* returns NULL and sets @c vm->error, and that the original pinned entry
* is still the one returned by @c vm_find_word().
*
* This enforces the Isabelle/HOL lemma @c ACL_Pin_Monotone: pin is
* permanent and cannot be overridden even by a new definition.
*
* Expected assertions (3):
* - @c vm_create_word() returns NULL for the shadowed name
* - @c vm->error is non-zero after the blocked create
* - @c vm_find_word() still returns the original pinned entry
*
* @param vm VM instance.
*/
static void test_acl_pin_blocks_shadow(VM *vm)
{
DictEntry *orig = vm_create_word(vm, "__acl_shadow_target__", 21, NULL);
if (!orig) { tests_failed++; return; }
orig->acl_pinned = 1;
DictEntry *shadow = vm_create_word(vm, "__acl_shadow_target__", 21, NULL);
ACL_ASSERT(shadow == NULL, "vm_create_word returns NULL for pinned name");
ACL_ASSERT(vm->error != 0, "vm->error set when shadow blocked");
vm->error = 0;
DictEntry *found = vm_find_word(vm, "__acl_shadow_target__", 21);
ACL_ASSERT(found == orig, "original pinned entry still found after blocked shadow");
}
/**
* @brief Test 9 — ACL-MODE@/ACL-PINNED?/ACL-TTL@/ACL-ALLOW@/ACL-HEAT@/
* ACL-WORD-ID read a word's ACL fields via the interpreter.
*
* Proof-covered field accessors (`proof/StarForth_ACL_*.thy`) that had no
* interpreter-level POST coverage before this test — every other ACL test
* in this file exercises the write accessors (`ACL-MODE!`/`ACL-TTL!`/
* `ACL-ALLOW!`) or calls the underlying C functions directly, but never
* pushed an xt and interpreted these six read words.
*
* Sets each field to a distinctive non-default value directly on a fresh
* test word, then pushes its xt and interprets each accessor in turn,
* checking the value returned on the stack.
*
* Expected assertions (6):
* - ACL-MODE@ returns @c ACL_MODE_STRICT
* - ACL-PINNED? returns -1 (true) for a pinned entry
* - ACL-TTL@ returns 4242
* - ACL-ALLOW@ returns 0 (false)
* - ACL-HEAT@ returns the entry's @c execution_heat
* - ACL-WORD-ID returns the entry's @c word_id
*
* @param vm VM instance.
*/
static void test_acl_read_accessors(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_read_test__", 18, NULL);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_STRICT;
e->acl_pinned = 1;
e->acl_ttl = 4242;
e->acl_allow = 0;
e->execution_heat = 777;
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-MODE@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)ACL_MODE_STRICT, "ACL-MODE@ reads acl_mode");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-PINNED?");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == -1, "ACL-PINNED? reads acl_pinned as true");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == 4242, "ACL-TTL@ reads acl_ttl");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-ALLOW@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == 0, "ACL-ALLOW@ reads acl_allow as false");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-HEAT@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)e->execution_heat, "ACL-HEAT@ reads execution_heat");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-WORD-ID");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)e->word_id, "ACL-WORD-ID reads word_id");
}
/**
* @brief Test 10 — ACL-INHERIT, as an interpreted FORTH word (src dst -- ).
*
* `test_acl_inherit` above already proves the underlying
* @c acl_inherit_entry() C function is correct (Isabelle lemma
* @c ACL_Inherit_Clears_Pin) by calling it directly. This test instead
* exercises the FORTH-level dispatch path itself — pushing two xts and
* interpreting "ACL-INHERIT" — which nothing in this file previously did,
* so the word's own stack-popping/argument-order code was untested.
*
* Expected assertions (2):
* - @c dst->acl_mode == ACL_MODE_STRICT after interpreting ACL-INHERIT
* - @c dst->acl_pinned == 0 after interpreting ACL-INHERIT
*
* @param vm VM instance.
*/
static void test_acl_inherit_word_dispatch(VM *vm)
{
DictEntry *src = vm_create_word(vm, "__acl_inh_src__", 15, NULL);
DictEntry *dst = vm_create_word(vm, "__acl_inh_dst__", 15, NULL);
if (!src || !dst) { tests_failed++; return; }
src->acl_mode = ACL_MODE_STRICT;
src->acl_pinned = 0;
dst->acl_pinned = 1;
dst->acl_mode = ACL_MODE_TTL;
vm_push(vm, (cell_t)(uintptr_t)src);
vm_push(vm, (cell_t)(uintptr_t)dst);
vm_interpret(vm, "ACL-INHERIT");
vm->error = 0;
ACL_ASSERT(dst->acl_mode == ACL_MODE_STRICT, "ACL-INHERIT (word) copies acl_mode");
ACL_ASSERT(dst->acl_pinned == 0, "ACL-INHERIT (word) clears acl_pinned");
}
/**
* @brief Test 11 — ACL-INIT-PRIMITIVES resets unpinned words, skips pinned ones.
*
* Creates two fresh words with non-default ACL state: one left unpinned,
* one pinned. Interprets "ACL-INIT-PRIMITIVES" (which walks the entire
* dictionary) and verifies the unpinned word was reset to the permissive
* defaults (@c acl_ttl=0, @c acl_allow=1, @c acl_mode=ACL_MODE_TTL) while
* the pinned word's deliberately-different state was left untouched.
*
* Expected assertions (4):
* - unpinned word's @c acl_ttl reset to 0
* - unpinned word's @c acl_allow reset to 1
* - unpinned word's @c acl_mode reset to ACL_MODE_TTL
* - pinned word's @c acl_ttl is NOT reset (still its original value)
*
* @param vm VM instance.
*/
static void test_acl_init_primitives(VM *vm)
{
DictEntry *unpinned = vm_create_word(vm, "__acl_initp_free__", 19, NULL);
DictEntry *pinned = vm_create_word(vm, "__acl_initp_pin__", 18, NULL);
if (!unpinned || !pinned) { tests_failed++; return; }
unpinned->acl_ttl = 555;
unpinned->acl_allow = 0;
unpinned->acl_mode = ACL_MODE_STRICT;
unpinned->acl_pinned = 0;
pinned->acl_ttl = 555;
pinned->acl_allow = 0;
pinned->acl_mode = ACL_MODE_STRICT;
pinned->acl_pinned = 1;
vm_interpret(vm, "ACL-INIT-PRIMITIVES");
vm->error = 0;
ACL_ASSERT(unpinned->acl_ttl == 0, "ACL-INIT-PRIMITIVES resets unpinned acl_ttl");
ACL_ASSERT(unpinned->acl_allow == 1, "ACL-INIT-PRIMITIVES resets unpinned acl_allow");
ACL_ASSERT(unpinned->acl_mode == ACL_MODE_TTL, "ACL-INIT-PRIMITIVES resets unpinned acl_mode");
ACL_ASSERT(pinned->acl_ttl == 555, "ACL-INIT-PRIMITIVES leaves pinned entry untouched");
}
/* ------------------------------------------------------------------ */
/**
* @brief Module 24 entry point — run all word-level ACL POST tests.
*
* Saves the current VM state (dsp, rsp, error, mode, emergency_console)
* before each sub-test and restores it between tests so failures do not
* cascade. Runs eleven tests covering:
*
* 1. ACL-PIN one-way ratchet (4 assertions)
* 2. ACL-INHERIT semantics (4 assertions)
* 3. emergency_console bypass (1 assertion)
* 4. ACL denial aborts word execution (2 assertions)
* 5. TTL hot-path decrement (1 assertion)
* 6. STRICT mode — TTL stays 0 (1 assertion or conditional skip)
* 7. Adaptive TTL via ACL-TTL-COMPUTE (1 assertion or conditional skip)
* 8. Pin blocks shadowing (3 assertions)
* 9. Read accessors — ACL-MODE@/PINNED?/TTL@/ALLOW@/HEAT@/WORD-ID (6 assertions)
* 10. ACL-INHERIT as an interpreted word, not just its C twin (2 assertions)
* 11. ACL-INIT-PRIMITIVES resets unpinned, skips pinned (4 assertions)
*
* Tests that depend on @c ACL.4th being loaded are conditionally skipped
* during bare POST (before @c ACL.4th runs) and counted as passes so the
* POST score is not penalised by load-order.
*
* @param vm VM instance; must be initialised and have the standard
* word vocabulary available.
*/
void run_acl_words_tests(VM *vm)
{
log_message(LOG_INFO, "Running ACL Words Tests (Module 24)...");
tests_passed = 0;
tests_failed = 0;
int saved_dsp, saved_rsp, saved_error;
vm_mode_t saved_mode;
save_vm_state(vm, &saved_dsp, &saved_rsp, &saved_error, &saved_mode);
uint8_t saved_ec = vm->emergency_console;
test_acl_pin_immutable(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_inherit(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_emergency_console_bypass(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_deny_aborts(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_ttl_hot_path(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_strict_mode(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_adaptive_ttl(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_pin_blocks_shadow(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_read_accessors(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_inherit_word_dispatch(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_init_primitives(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
vm->emergency_console = saved_ec;
print_module_summary("ACL Words", tests_passed, tests_failed, 0, 0);
}
v3/src/test_runner/modules/arithmetic_words_test.c
+285
View File
@@ -0,0 +1,285 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Arithmetic Words Test Suites - Module 5 */
static WordTestSuite arithmetic_word_suites[] = {
{
"+", {
{"basic", "5 7 + . CR", "Should print: 12", TEST_NORMAL, 0, 1, {0}},
{"zero_add", "42 0 + . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 3 + . CR", "Should print: -2", TEST_NORMAL, 0, 1, {0}},
{"both_negative", "-5 -3 + . CR", "Should print: -8", TEST_NORMAL, 0, 1, {0}},
{"overflow", "2147483647 1 + . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"underflow", "-2147483648 -1 + . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 +", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"-", {
{"basic", "10 3 - . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"zero_sub", "42 0 - . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"from_zero", "0 5 - . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"negative", "5 -3 - . CR", "Should print: 8", TEST_NORMAL, 0, 1, {0}},
{"same_values", "42 42 - . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"overflow", "-2147483648 1 - . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"underflow", "2147483647 -1 - . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 -", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"*", {
{"basic", "6 7 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 * . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"by_negative", "6 -7 * . CR", "Should print: -42", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-6 -7 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"large_numbers", "32767 2 * . CR", "Should print: 65534", TEST_EDGE_CASE, 0, 1, {0}},
{"overflow", "65536 65536 * . CR", "May overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 *", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"/", {
{"basic", "15 3 / . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 / . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative_dividend", "-15 3 / . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"negative_divisor", "15 -3 / . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"both_negative", "-15 -3 / . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"truncation", "7 3 / . CR", "Should print: 2 (truncated)", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 /", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 /", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"MOD", {
{"basic", "17 5 MOD . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"exact_division", "15 3 MOD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 MOD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_dividend", "-17 5 MOD . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"negative_divisor", "17 -5 MOD . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"small_by_large", "3 7 MOD . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"/MOD", {
{"basic", "17 5 /MOD . . CR", "Should print: 3 2", TEST_NORMAL, 0, 1, {0}},
{"exact", "15 3 /MOD . . CR", "Should print: 5 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-17 5 /MOD . . CR","Should handle negative dividend", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 /MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "/MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 /MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"ABS", {
{"positive", "42 ABS . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 ABS . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 ABS . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"min_int", "-2147483648 ABS . CR", "Should print: 2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "ABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"NEGATE", {
{"positive", "42 NEGATE . CR", "Should print: -42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 NEGATE . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 NEGATE . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"min_int", "-2147483648 NEGATE . CR", "Should print: 2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "NEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"MIN", {
{"basic", "5 3 MIN . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 42 MIN . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 -3 MIN . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 1 MIN . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 MIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"MAX", {
{"basic", "5 3 MAX . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 42 MAX . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 -3 MAX . CR", "Should print: -3", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 1 MAX . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 MAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"1+", {
{"basic", "5 1+ . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 1+ . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 1+ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"chain", "3 1+ 1+ 1+ . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"overflow", "2147483647 1+ . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "1+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"1-", {
{"basic", "5 1- . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"to_zero", "1 1- . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"to_negative", "0 1- . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"chain", "6 1- 1- 1- . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"underflow", "-2147483648 1- . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "1-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2+", {
{"basic", "5 2+ . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2+ . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"negative", "-3 2+ . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"2-", {
{"basic", "7 2- . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"zero", "2 2- . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "0 2- . CR", "Should print: -2", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"2*", {
{"basic", "5 2* . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2* . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-3 2* . CR", "Should print: -6", TEST_NORMAL, 0, 1, {0}},
{"one", "1 2* . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"large", "1073741823 2* . CR", "Should print: 2147483646", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "2*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2/", {
{"basic", "10 2/ . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"odd", "7 2/ . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2/ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_even", "-10 2/ . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"one", "1 2/ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all arithmetic word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for arithmetic operations including
* basic operations (+, -, *, /), modulo operations (MOD, /MOD),
* and numeric functions (ABS, NEGATE, MIN, MAX)
*/
void run_arithmetic_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Arithmetic Words Tests (Module 5)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; arithmetic_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &arithmetic_word_suites[i], mod);
}
print_module_summary("Arithmetic Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/block_words_test.c
+213
View File
@@ -0,0 +1,213 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for FORTH block words (Module 16)
*
* Contains test cases for the following FORTH words:
* - BLOCK: Block access
* - BUFFER: Buffer management
* - UPDATE: Block modification marking
* - SAVE-BUFFERS: Buffer flushing
* - EMPTY-BUFFERS: Buffer invalidation
* - FLUSH: Buffer saving and invalidation
* - LOAD: Block interpretation
* - LIST: Block display
* - SCR: Current block number
* - THRU: Load block range
* - -->: Continue to next block
*/
static WordTestSuite block_word_suites[] = {
{
"BLOCK", {
{"basic", "1 BLOCK DUP . CR", "Should return block address", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 BLOCK", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"large_block", "65536 BLOCK", "Should handle large number", TEST_ERROR_CASE, 1, 1, {0}},
{"negative", "-1 BLOCK", "Should handle negative", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "BLOCK", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"BUFFER", {
{"basic", "1 BUFFER DUP . CR", "Should return buffer address", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 BUFFER", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"flush_dirty", "2 BLOCK 1+ 2 BUFFER", "Should flush if dirty", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "BUFFER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"UPDATE", {
{"basic", "1 BLOCK UPDATE", "Should mark block dirty", TEST_NORMAL, 0, 1, {0}},
{"multiple", "1 BLOCK UPDATE UPDATE", "Should handle multiple updates", TEST_NORMAL, 0, 1, {0}},
{"no_block", "0 SCR ! UPDATE", "Should error: blk=0 is invalid", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"SAVE-BUFFERS", {
{"basic", "SAVE-BUFFERS", "Should flush all buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE SAVE-BUFFERS", "Should save dirty blocks", TEST_NORMAL, 0, 1, {0}},
{"no_dirty", "SAVE-BUFFERS", "Should handle no dirty blocks", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"EMPTY-BUFFERS", {
{"basic", "EMPTY-BUFFERS", "Should invalidate all buffers", TEST_NORMAL, 0, 1, {0}},
{"after_use", "1 BLOCK EMPTY-BUFFERS", "Should invalidate used buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE EMPTY-BUFFERS", "Should handle dirty blocks", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"FLUSH", {
{"basic", "FLUSH", "Should save and invalidate buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE FLUSH", "Should flush dirty blocks", TEST_NORMAL, 0, 1, {0}},
{"after_empty", "EMPTY-BUFFERS FLUSH", "Should handle empty buffers", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LOAD", {
{"basic", "1 LOAD", "Should interpret block 1", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 LOAD", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"nonexistent", "9999 LOAD", "Should handle missing block", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "LOAD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"LIST", {
{"basic", "1 LIST", "Should display block 1", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 LIST", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"nonexistent", "9999 LIST", "Should handle missing block", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "LIST", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SCR", {
{"basic", "SCR @ . CR", "Should show current block", TEST_NORMAL, 0, 1, {0}},
{"after_list", "1 LIST SCR @ . CR", "Should update after LIST", TEST_NORMAL, 0, 1, {0}},
{"after_load", "1 LOAD SCR @ . CR", "Should update after LOAD", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"THRU", {
/* Basic functionality */
{"single_block", "1 1 THRU", "Should load single block (1-1)", TEST_NORMAL, 0, 1, {0}},
{"ascending", "1 3 THRU", "Should load blocks 1-3 in order", TEST_NORMAL, 0, 1, {0}},
{"descending", "3 1 THRU", "Should auto-swap and load 1-3", TEST_NORMAL, 0, 1, {0}},
{"same_block", "2 2 THRU", "Should load single block (2-2)", TEST_NORMAL, 0, 1, {0}},
/* Error cases - invalid block numbers */
{"zero_start", "0 3 THRU", "Should reject block 0 as start", TEST_ERROR_CASE, 1, 1, {0}},
{"zero_end", "1 0 THRU", "Should reject block 0 as end", TEST_ERROR_CASE, 1, 1, {0}},
{"both_zero", "0 0 THRU", "Should reject both blocks as 0", TEST_ERROR_CASE, 1, 1, {0}},
{"invalid_start", "9999 10000 THRU", "Should reject invalid start block", TEST_ERROR_CASE, 1, 1, {0}},
{"invalid_end", "1 9999 THRU", "Should reject invalid end block", TEST_ERROR_CASE, 1, 1, {0}},
{"both_invalid", "9998 9999 THRU", "Should reject both invalid blocks", TEST_ERROR_CASE, 1, 1, {0}},
/* Stack underflow */
{"empty_stack", "THRU", "Should cause stack underflow (no args)", TEST_ERROR_CASE, 1, 1, {0}},
{"one_arg", "1 THRU", "Should cause stack underflow (one arg)", TEST_ERROR_CASE, 1, 1, {0}},
/* Range tests */
{"small_range", "1 2 THRU", "Should load 2-block range", TEST_NORMAL, 0, 1, {0}},
{"medium_range", "1 5 THRU", "Should load 5-block range", TEST_NORMAL, 0, 1, {0}},
/* Edge cases */
{"negative_start", "-1 3 THRU", "Should handle negative start", TEST_ERROR_CASE, 1, 1, {0}},
{"negative_end", "1 -3 THRU", "Should handle negative end", TEST_ERROR_CASE, 1, 1, {0}},
{"both_negative", "-3 -1 THRU", "Should handle both negative", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
17, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all block words test suites
* @param vm Pointer to the FORTH virtual machine instance
*
* Runs through all test cases for block manipulation words, including
* block access, buffer management, and block I/O operations. Results
* are logged and summarized after completion.
*/
void run_block_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Block Words Tests (Module 16)...");
for (int i = 0; block_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &block_word_suites[i]);
}
print_module_summary("Block Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/break_me_tests.c
+202
View File
@@ -0,0 +1,202 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "test_runner.h"
#include "../../../include/log.h"
#include "../../../include/vm.h"
/* Report file handle */
static FILE *report_file = NULL;
static time_t test_start_time;
static time_t test_end_time;
static int total_tests_run = 0;
/**
* @brief Initialize markdown report file
*/
static int init_report(void) {
time(&test_start_time);
report_file = fopen("docs/BREAK_ME_REPORT.md", "w");
if (!report_file) {
log_message(LOG_ERROR, "Failed to create BREAK_ME_REPORT.md");
return -1;
}
char time_str[64];
struct tm *tm_info = localtime(&test_start_time);
strftime(time_str, sizeof(time_str), "%Y-%m-%d %H:%M:%S", tm_info);
fprintf(report_file, "# 🔥 STARFORTH BREAK-ME DIAGNOSTIC REPORT 🔥\n\n");
fprintf(report_file, "## Executive Summary\n\n");
fprintf(report_file, "**Generated:** %s\n\n", time_str);
fprintf(report_file, "**Test Mode:** ULTRA-COMPREHENSIVE DIAGNOSTIC\n\n");
fprintf(report_file, "**Purpose:** This report documents the results_run_01_2025_12_08 of the most exhaustive ");
fprintf(report_file, "testing suite ever run on StarForth. Every word, every edge case, ");
fprintf(report_file, "every pathological scenario has been tested to ensure rock-solid ");
fprintf(report_file, "reliability and FORTH-79 standard compliance.\n\n");
fprintf(report_file, "---\n\n");
return 0;
}
/**
* @brief Finalize report with system info and easter egg
*/
static void finalize_report(VM *vm) {
time(&test_end_time);
if (!report_file) return;
/* Performance metrics */
fprintf(report_file, "\n## 📊 Performance Metrics\n\n");
fprintf(report_file, "| Metric | Value |\n");
fprintf(report_file, "|--------|-------|\n");
fprintf(report_file, "| Test Duration | %.2f seconds |\n", difftime(test_end_time, test_start_time));
fprintf(report_file, "| Total Tests | %d |\n", total_tests_run);
fprintf(report_file, "| Tests/Second | %.2f |\n\n",
total_tests_run / difftime(test_end_time, test_start_time));
/* System info */
fprintf(report_file, "## 🖥️ System Information\n\n");
fprintf(report_file, "| Component | Specification |\n");
fprintf(report_file, "|-----------|---------------|\n");
fprintf(report_file, "| VM Architecture | Direct-threaded |\n");
fprintf(report_file, "| Standard | FORTH-79 + StarForth Extensions |\n");
fprintf(report_file, "| Cell Size | %zu bytes |\n", sizeof(cell_t));
fprintf(report_file, "| Stack Size | %d cells |\n", STACK_SIZE);
fprintf(report_file, "| Memory | %d bytes |\n\n", VM_MEMORY_SIZE);
/* Easter egg */
fprintf(report_file, "\n---\n\n");
fprintf(report_file, "## 🎉 EASTER EGG: THE STARFORTH CHALLENGE 🎉\n\n");
fprintf(report_file, "```\n");
fprintf(report_file, " ⭐ C O N G R A T U L A T I O N S ⭐\n\n");
fprintf(report_file, " You've discovered the hidden StarForth challenge!\n\n");
fprintf(report_file, " Your system just survived %d exhaustive tests.\n", total_tests_run);
fprintf(report_file, " But can YOU survive the ULTIMATE FORTH CHALLENGE?\n\n");
fprintf(report_file, " 🏆 THE STARFORTH MASTER CHALLENGE 🏆\n\n");
fprintf(report_file, " Write a Forth program that:\n");
fprintf(report_file, " 1. Prints the Fibonacci sequence up to 1000\n");
fprintf(report_file, " 2. Uses ONLY the following words:\n");
fprintf(report_file, " : ; DUP OVER DROP SWAP . CR < IF THEN DO LOOP\n");
fprintf(report_file, " 3. Fits in exactly 79 characters (FORTH-79 tribute!)\n\n");
fprintf(report_file, " Submit your solution to the StarForth community!\n\n");
fprintf(report_file, " Hint: Think recursively, but remember FORTH-79\n");
fprintf(report_file, " doesn't have RECURSE... 😉\n\n");
fprintf(report_file, " ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n\n");
fprintf(report_file, " BONUS SECRET: If you ran --break-me, you're already\n");
fprintf(report_file, " in the top 1%% of Forth enthusiasts. Welcome to the\n");
fprintf(report_file, " elite club! Your system just proved it can handle\n");
fprintf(report_file, " anything you throw at it.\n\n");
fprintf(report_file, " May your stacks be balanced and your words defined,\n");
fprintf(report_file, " -- The StarForth Development Team ⭐\n");
fprintf(report_file, "```\n\n");
fprintf(report_file, "### 🎮 More Easter Eggs to Find:\n\n");
fprintf(report_file, "1. Try defining a word called `STARSHIP` and see what happens\n");
fprintf(report_file, "2. Run `42 ENTROPY@ .` to see the universe's favorite number\n");
fprintf(report_file, "3. Type `WORDS` and count how many contain 'STAR'\n");
fprintf(report_file, "4. Check what happens when you `FORGET FORGET` (just kidding, don't!)\n\n");
fprintf(report_file, "---\n\n");
fprintf(report_file, "*Generated by StarForth --break-me mode*\n");
fprintf(report_file, "*Copyright (c) 2025 Robert A. James - StarshipOS Forth Project*\n");
fclose(report_file);
report_file = NULL;
}
/**
* @brief Main entry point for --break-me mode
*/
void run_break_me_tests(VM *vm) {
if (!vm) return;
log_message(LOG_INFO, "");
log_message(LOG_INFO, "╔═══════════════════════════════════════════════════════════╗");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ 🔥 BREAK-ME MODE ACTIVATED 🔥 ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ Ultra-Comprehensive StarForth Diagnostic Suite ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ Preparing to execute EXHAUSTIVE test battery... ║");
log_message(LOG_INFO, "║ Generating detailed markdown report... ║");
log_message(LOG_INFO, "║ Surprise easter egg awaits at the end! ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "╚═══════════════════════════════════════════════════════════╝");
log_message(LOG_INFO, "");
/* Initialize report */
if (init_report() != 0) {
log_message(LOG_ERROR, "Failed to initialize report - aborting");
return;
}
/* Run ALL existing test suites */
log_message(LOG_INFO, "Running comprehensive test suite...");
run_all_tests(vm);
/* Update counter from global stats */
extern TestStats global_test_stats;
total_tests_run = global_test_stats.total_tests;
/* Finalize report */
finalize_report(vm);
log_message(LOG_INFO, "");
log_message(LOG_INFO, "╔═══════════════════════════════════════════════════════════╗");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ ✅ BREAK-ME COMPLETE ✅ ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ StarForth survived %d tests! ║", total_tests_run);
log_message(LOG_INFO, "║ Check docs/BREAK_ME_REPORT.md for full details ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ 🎉 Don't forget to read the easter egg! 🎉 ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "╚═══════════════════════════════════════════════════════════╝");
log_message(LOG_INFO, "");
}
v3/src/test_runner/modules/control_words_test.c
+267
View File
@@ -0,0 +1,267 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/** @brief Test suites for FORTH control words
* @details Contains test cases for all control flow words in Module 12,
* including conditional branches and loop structures
*/
static WordTestSuite control_word_suites[] = {
{
"IF", {
{"true", ": TEST1 IF 42 ELSE 24 THEN ; -1 TEST1 . CR", "Should take true branch", TEST_NORMAL, 0, 1, {0}},
{"false", ": TEST2 IF 42 ELSE 24 THEN ; 0 TEST2 . CR", "Should take false branch", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST3 IF IF 1 ELSE 2 THEN ELSE 3 THEN ; -1 -1 TEST3 . CR", "Should handle nesting",
TEST_NORMAL, 0, 1, {0}
},
{"no_else", ": TEST4 IF 42 THEN ; -1 TEST4 . CR", "Should work without ELSE", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "IF", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ELSE", {
{"alone", "ELSE", "Should error outside IF", TEST_ERROR_CASE, 1, 1, {0}},
{"double", ": BAD IF 1 ELSE ELSE 2 THEN ;", "Should prevent double ELSE", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"THEN", {
{"alone", "THEN", "Should error outside IF", TEST_ERROR_CASE, 1, 1, {0}},
{"extra", ": BAD IF 1 THEN THEN ;", "Should prevent extra THEN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"BEGIN", {
{"until", ": TEST5 0 BEGIN 1+ DUP 5 = UNTIL ; TEST5 . CR", "Should loop until true", TEST_NORMAL, 0, 1, {0}},
{
"while", ": TEST6 0 BEGIN DUP 5 < WHILE 1+ REPEAT ; TEST6 . CR", "Should loop while true", TEST_NORMAL, 0, 1, {0}
},
/* TODO: Nested control flow - needs compiler refactoring for proper origin stack */
/* {"nested", ": TEST7 0 BEGIN 1+ BEGIN DUP 3 < WHILE 1+ REPEAT DUP 5 = UNTIL ;", "Should handle nesting", TEST_NORMAL, 0, 1}, */
{"alone", "BEGIN", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"UNTIL", {
{"basic", ": TEST8 BEGIN DUP 1- DUP 0= UNTIL ; 5 TEST8 . CR", "Should count down", TEST_NORMAL, 0, 1, {0}},
{"immediate", ": TEST9 BEGIN 1 UNTIL ; IMMEDIATE", "Should be immediate", TEST_NORMAL, 0, 1, {0}},
{"no_begin", "UNTIL", "Should error without BEGIN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"WHILE", {
{"basic", ": TEST10 BEGIN DUP 5 < WHILE 1+ REPEAT ; 0 TEST10 . CR", "Should count up", TEST_NORMAL, 0, 1, {0}},
{
"zero_times", ": TEST11 BEGIN DUP 0< WHILE 1+ REPEAT ; 0 TEST11 . CR", "Should handle zero iterations",
TEST_NORMAL, 0, 1, {0}
},
{"no_begin", "WHILE", "Should error without BEGIN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"REPEAT", {
{
"basic", ": TEST12 BEGIN DUP 5 < WHILE 1+ REPEAT ; 0 TEST12 . CR", "Should terminate loop", TEST_NORMAL, 0, 1, {0}
},
{"no_while", "REPEAT", "Should error without WHILE", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"DO", {
{"basic", ": TEST13 5 0 DO I . LOOP ; TEST13 CR", "Should count 0 to 4", TEST_NORMAL, 0, 1, {0}},
{"negative", ": TEST14 -1 -5 DO I . LOOP ; TEST14 CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"empty", ": TEST15 0 0 DO LOOP ;", "Should handle empty range", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST16 3 0 DO 3 0 DO J I + . LOOP LOOP ; TEST16 CR", "Should handle nesting", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"?DO", {
{"basic", ": TEST17 5 0 ?DO I . LOOP ; TEST17 CR", "Should count 0 to 4", TEST_NORMAL, 0, 1, {0}},
{"skip", ": TEST18 1 1 ?DO I . LOOP ;", "Should skip when equal", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST19 3 0 ?DO 3 I ?DO J I + . LOOP LOOP ; TEST19 CR", "Should handle nesting",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LOOP", {
{"basic", ": TEST20 5 0 DO I . LOOP ; TEST20 CR", "Should increment by 1", TEST_NORMAL, 0, 1, {0}},
{"no_do", "LOOP", "Should error without DO", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"+LOOP", {
{"basic", ": TEST21 10 0 DO I . 2 +LOOP ; TEST21 CR", "Should count by 2", TEST_NORMAL, 0, 1, {0}},
{"negative", ": TEST22 0 10 DO I . -1 +LOOP ; TEST22 CR", "Should count down", TEST_NORMAL, 0, 1, {0}},
{"variable", ": TEST23 10 0 DO I . DUP +LOOP ; 3 TEST23 CR", "Should use stack value", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"I", {
{"basic", ": TI 4 0 DO I . LOOP CR ; TI", "Should print: 0 1 2 3", TEST_NORMAL, 0, 1, {0}},
{"single", ": TI1 1 0 DO I . LOOP CR ; TI1", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"offset", ": TI2 5 3 DO I . LOOP CR ; TI2", "Should print: 3 4", TEST_NORMAL, 0, 1, {0}},
{"in_expr", ": TI3 3 0 DO I 2 * . LOOP CR ; TI3", "Should print: 0 2 4", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"J", {
{"basic", ": TJ 2 0 DO 3 0 DO J . LOOP LOOP CR ; TJ", "Should print: 0 0 0 1 1 1", TEST_NORMAL, 0, 1, {0}},
{"paired", ": TJ2 2 0 DO 2 0 DO J I + . LOOP LOOP CR ; TJ2", "Should print: 0 1 1 2", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"EXIT", {
{"early_return", ": TEX 5 EXIT 99 ; TEX . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"cond_exit_pos", ": TEX2 DUP 0> IF EXIT THEN NEGATE ; 3 TEX2 . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"cond_exit_neg", ": TEX2 DUP 0> IF EXIT THEN NEGATE ; -4 TEX2 . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"no_skipped", ": TEX3 1 2 EXIT 3 ; TEX3 . . CR", "Should print: 2 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"LEAVE", {
{"basic", ": TLV 0 5 0 DO I 3 = IF LEAVE THEN 1+ LOOP ; TLV . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"at_start", ": TLV2 0 5 0 DO LEAVE 1+ LOOP ; TLV2 . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"qdloop", ": TLV3 0 5 0 ?DO I 2 = IF LEAVE THEN 1+ LOOP ; TLV3 . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"UNLOOP", {
{"early_exit", ": TUL 5 0 DO I 2 = IF UNLOOP 42 EXIT THEN LOOP 99 ; TUL . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"full_loop", ": TUL2 5 0 DO I 9 = IF UNLOOP 77 EXIT THEN LOOP 99 ; TUL2 . CR", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"AGAIN", {
{"basic", ": TAG 0 BEGIN 1+ DUP 3 = IF EXIT THEN AGAIN ; TAG . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"countdown",": CD 10 BEGIN 1- DUP 0= IF EXIT THEN AGAIN ; CD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CASE", {
{"match_1", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 1 TC", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"match_2", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 2 TC", "Should print: 20", TEST_NORMAL, 0, 1, {0}},
{"default", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 5 TC", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{"zero_case", ": TC CASE 0 OF 88 ENDOF 1 OF 77 ENDOF 66 SWAP ENDCASE . CR ; 0 TC", "Should print: 88", TEST_NORMAL, 0, 1, {0}},
{"neg_case", ": TC CASE -1 OF 55 ENDOF 44 SWAP ENDCASE . CR ; -1 TC", "Should print: 55", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/** @brief Executes all control words test suites
* @param vm Pointer to the FORTH virtual machine instance
* @details Runs through all defined test cases for control words,
* testing conditional branches and loop constructs
*/
void run_control_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Control Words Tests (Module 12)...");
for (int i = 0; control_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &control_word_suites[i]);
run_test_suite(vm, &control_word_suites[i]);
}
print_module_summary("Control Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/defining_words_tests.c
+191
View File
@@ -0,0 +1,191 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/** @brief Test suites for Forth defining words (Module 13)
* @details Contains test cases for core defining words including:
* :, ;, CONSTANT, VARIABLE, CREATE, DOES>, [, and ]
*/
static WordTestSuite defining_word_suites[] = {
{
":", {
{"basic", ": TEST1 42 ; TEST1 . CR", "Should define and execute", TEST_NORMAL, 0, 1, {0}},
{"empty_name", ":", "Should handle empty definition", TEST_ERROR_CASE, 1, 1, {0}},
{"nested", ": TEST3 : ;", "Should prevent nested definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
";", {
{"alone", ";", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{"immediate", ": TEST4 42 ; IMMEDIATE TEST4 . CR", "Should handle immediate", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CONSTANT", {
{"basic", "42 CONSTANT MEANING MEANING . CR", "Should create constant", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 CONSTANT ZERO ZERO . CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 CONSTANT MINUS MINUS . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "CONSTANT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"VARIABLE", {
{"basic", "VARIABLE VAR1 42 VAR1 ! VAR1 @ . CR", "Should create variable", TEST_NORMAL, 0, 1, {0}},
{"multiple", "VARIABLE VAR2 VARIABLE VAR3", "Should create multiple", TEST_NORMAL, 0, 1, {0}},
{"store_fetch", "VARIABLE VAR4 -99 VAR4 ! VAR4 @ . CR", "Should store/fetch", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CREATE", {
{"basic", "CREATE OBJ1", "Should create word", TEST_NORMAL, 0, 1, {0}},
{"with_data", "CREATE OBJ2 42 , OBJ2 @ . CR", "Should allow data", TEST_NORMAL, 0, 1, {0}},
{"empty_name", "CREATE", "Should handle empty name", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"DOES>", {
{
"basic", ": CONST CREATE , DOES> @ ; 42 CONST MEANING MEANING . CR", "Should define behavior",
TEST_NORMAL, 0, 1, {0}
},
{
"multiple", ": ARRAY CREATE DOES> SWAP CELLS + ; CREATE ARR 10 CELLS ALLOT", "Should work with arrays",
TEST_NORMAL, 0, 1, {0}
},
{"outside", "DOES>", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"[", {
{"basic", ": TEST5 [ 42 ] LITERAL ; TEST5 . CR", "Should enter interpret", TEST_NORMAL, 0, 1, {0}},
{"outside", "[", "Should be allowed outside definition (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"]", {
{"basic", "[ 42 ] . CR", "Should resume compile", TEST_NORMAL, 0, 1, {0}},
{"nested", ": TEST6 [ ] 42 ; TEST6 . CR", "Should handle nesting", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"DEFER", {
{"basic", "DEFER DF1 : DF1W 42 . CR ; ' DF1W IS DF1 DF1", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"uninit", "DEFER DF2 DF2", "Should error: uninitialized deferred word", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"IS", {
{"basic", "DEFER IS1 : IS1W 99 . CR ; ' IS1W IS IS1 IS1", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{"not_defer", "42 IS DUP", "Should error: DUP is not a DEFER word", TEST_ERROR_CASE, 1, 1, {0}},
{"not_found", "42 IS NOSUCH", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"DEFER@", {
{"basic", "DEFER DFA1 : DFA1W 7 . CR ; ' DFA1W IS DFA1 DEFER@ DFA1 0<> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"not_found", "DEFER@ NOSUCH2", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"[']", {
{"compile_xt", ": BKT1 ['] DUP ; 77 BKT1 EXECUTE . . CR", "Should print: 77 77", TEST_NORMAL, 0, 1, {0}},
{"pin_like", ": BKT2 ['] DROP ; 1 2 BKT2 EXECUTE . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"not_found", ": BKT3 ['] NOSUCHWORD ;", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/** @brief Executes all test suites for Forth defining words
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through each test suite in defining_word_suites array,
* executing individual test cases and logging results_run_01_2025_12_08
*/
void run_defining_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Defining Words Tests (Module 13)...");
for (int i = 0; defining_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &defining_word_suites[i]);
}
print_module_summary("Defining Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/dictionary_manipulation_words_test.c
+194
View File
@@ -0,0 +1,194 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Dictionary Manipulation Words Test Suites - Module 14 */
static WordTestSuite dict_manip_word_suites[] = {
{
"CREATE", {
{"basic", "CREATE test1 42 , test1 @ . CR", "Should create and store", TEST_NORMAL, 0, 1, {0}},
{"empty_name", "CREATE", "Should handle empty name", TEST_ERROR_CASE, 1, 1, {0}},
{
"redefine_shadows", "CREATE T 1 , CREATE T 2 , T @ . CR", "Newest definition should win (prints 2)",
TEST_NORMAL, 0, 1, {0}
},
{"duplicate", "CREATE test2 CREATE test2", "Should allow redefinition (latest shadows)", TEST_NORMAL, 0, 1, {0}},
{"long_name", "CREATE abcdefghijklmnopqrstuvwxyz", "Should handle long name", TEST_EDGE_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"FORGET", {
{"basic", "CREATE temp1 FORGET temp1", "Should forget word", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "FORGET nonexistent", "Should handle missing word", TEST_ERROR_CASE, 1, 1, {0}},
{"protected", "FORGET FORGET", "Should protect system words", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
/* FENCE ( -- ): raises the FORGET boundary to the current dictionary
* top. Added alongside a real bug fix in FORGET itself, caught while
* building this word -- forgetting the single newest word used to
* incorrectly destroy every other word back to the fence too (a
* use-after-free in the relink logic, not just an off-by-one), a
* SIGSEGV in the worst case. "forget_latest_keeps_predecessor" below
* is exactly the regression case that fix addresses. */
"FENCE", {
{
"basic", "CREATE fnc1 FENCE CREATE fnc2 FORGET fnc2",
"Should forget a word defined after FENCE", TEST_NORMAL, 0, 1, {0}
},
{
"protects_older", "CREATE fnc3 CREATE fnc4 FENCE FORGET fnc3",
"Should refuse to forget a word defined before FENCE", TEST_ERROR_CASE, 1, 1, {0}
},
{
"forget_latest_keeps_predecessor",
"CREATE fnc5 FENCE CREATE fnc6 CREATE fnc7 FORGET fnc7 fnc6 DROP",
"Forgetting the newest word must not disturb an older one still above FENCE",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"IMMEDIATE", {
{"basic", ": test3 42 ; IMMEDIATE test3 . CR", "Should execute immediately", TEST_NORMAL, 0, 1, {0}},
{
"already_immediate", ": test4 43 ; IMMEDIATE IMMEDIATE", "Should handle double immediate", TEST_NORMAL, 0, 1, {0}
},
/* TODO: IMMEDIATE outside definition - requires compile-state tracking in IMMEDIATE */
/* {"outside_def", "IMMEDIATE", "Should error outside definition", TEST_ERROR_CASE, 1, 1}, */
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"FIND", {
{"existing", "FIND DUP . CR", "Should find system word", TEST_NORMAL, 0, 1, {0}},
{"user_word", ": test5 44 ; FIND test5 . CR", "Should find user word", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "FIND nonexistent . CR", "Should return 0", TEST_NORMAL, 0, 1, {0}},
{"empty", "FIND", "Should error (no token)", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"DEFINITIONS", {
{"basic", "FORTH DEFINITIONS", "Should set current to context", TEST_NORMAL, 0, 1, {0}},
{"multiple", "FORTH DEFINITIONS DEFINITIONS", "Should be idempotent", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"SMUDGE", {
{"during_def", ": test6 SMUDGE 45 ;", "Should hide incomplete def", TEST_NORMAL, 0, 1, {0}},
{"outside_def", "SMUDGE", "Should error outside def", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"LATEST", {
{"basic", "LATEST @ . CR", "Should show latest word", TEST_NORMAL, 0, 1, {0}},
{"after_def", ": test7 46 ; LATEST @ . CR", "Should update after def", TEST_NORMAL, 0, 1, {0}},
{
"after_forget", "CREATE test8 FORGET test8 LATEST @ . CR", "Should update after forget", TEST_NORMAL, 0,
1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
">BODY", {
{"basic", "CREATE test9 ' test9 >BODY . CR", "Should get param field", TEST_NORMAL, 0, 1, {0}},
{"variable", "VARIABLE var1 ' var1 >BODY . CR", "Should get var storage", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "' NONEXISTENT >BODY", "Should handle missing word", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HIDDEN", {
{"basic", ": test10 HIDDEN 47 ;", "Should hide word", TEST_NORMAL, 0, 1, {0}},
{"outside_def", "HIDDEN", "Should error outside def", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all dictionary manipulation words test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for CREATE, FORGET, IMMEDIATE, FIND,
* DEFINITIONS, SMUDGE, LATEST, >BODY, and HIDDEN words
*/
void run_dictionary_manipulation_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Dictionary Manipulation Words Tests (Module 14)...");
for (int i = 0; dict_manip_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &dict_manip_word_suites[i]);
}
print_module_summary("Dictionary Manipulation Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/dictionary_words_test.c
+216
View File
@@ -0,0 +1,216 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Dictionary Words Test Suites - Module 4 */
static WordTestSuite dictionary_word_suites[] = {
{
"HERE", {
{"basic", "HERE HERE = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"after_comma", "HERE 42 , HERE SWAP - 1 CELLS = 0 SWAP /", "Asserts HERE advances by exactly 1 CELLS (8 bytes on 64-bit)", TEST_NORMAL, 0, 1, {0}},
{"after_c_comma", "HERE 65 C, HERE SWAP - . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"after_allot", "HERE 10 ALLOT HERE SWAP - . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"stability", "HERE DUP HERE = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ALLOT", {
{"basic", "HERE 10 ALLOT HERE SWAP - . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "HERE 0 ALLOT HERE SWAP - . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "HERE -4 ALLOT HERE SWAP - . CR", "Should print: -4", TEST_NORMAL, 0, 1, {0}},
{"large", "HERE 100 ALLOT HERE SWAP - . CR", "Should print: 100", TEST_NORMAL, 0, 1, {0}},
{"after_use", "ALIGN HERE 10 ALLOT 42 OVER ! @ . CR", "Should store and retrieve", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "ALLOT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
",", {
{"basic", "42 , HERE 1 CELLS - @ . CR", "Should compile 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-999 , HERE 1 CELLS - @ . CR", "Should compile -999", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 , HERE 1 CELLS - @ . CR", "Should compile 0", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 , HERE 1 CELLS - @ . CR", "Should compile max int", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 , HERE 1 CELLS - @ . CR", "Should compile min int", TEST_EDGE_CASE, 0, 1, {0}},
{"multiple", "10 , 20 , HERE 1 CELLS - @ . HERE 1 CELLS - @ . CR", "Should compile multiple", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", ",", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"C,", {
{"basic", "65 C, HERE 1 - C@ . CR", "Should compile byte 65", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 C, HERE 1 - C@ . CR", "Should compile byte 0", TEST_NORMAL, 0, 1, {0}},
{"high_byte", "255 C, HERE 1 - C@ . CR", "Should compile byte 255", TEST_NORMAL, 0, 1, {0}},
{"truncation", "256 C, HERE 1 - C@ . CR", "Should truncate to 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 C, HERE 1 - C@ . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"multiple", "65 C, 66 C, HERE 2 - C@ . HERE 1 - C@ . CR", "Should compile multiple", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "C,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"2,", {
{"basic", "12345 67890 2, HERE 2 CELLS - 2@ . . CR", "Should compile double", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 2, HERE 2 CELLS - 2@ . . CR", "Should compile zero double", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1000 -2000 2, HERE 2 CELLS - 2@ . . CR", "Should compile negative double", TEST_NORMAL, 0, 1, {0}},
{"large", "2147483647 -1 2, HERE 2 CELLS - 2@ . . CR", "Should compile large double", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 2,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"PAD", {
{"basic", "PAD PAD = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"different_from_here", "PAD HERE = . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"stability", "PAD DUP PAD = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{"usable", "PAD 42 OVER ! @ . CR", "Should be usable memory", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SP@", {
// DISABLED: flaky on some architectures, non-deterministic
{"basic", "SP@ SP@ = . CR", "Should print: 0 (different after push)", TEST_NORMAL, 0, 0, {0}},
{"depth_effect", "42 SP@ SWAP DROP SP@ = . CR", "Should show stack effect", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "DEPTH 0= SP@ AND . CR", "Should work on empty stack", TEST_NORMAL, 0, 1, {0}},
{
"multiple_items", "1 2 3 SP@ SWAP DROP SWAP DROP SWAP DROP SP@ = . CR", "Should track changes",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SP!", {
{"basic_restore", "1 2 3 SP@ 4 5 6 DROP DROP DROP SP! DEPTH .", "Should restore stack", TEST_NORMAL, 0, 1, {0}},
{"invalid_addr", "0 SP!", "Should cause error", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "SP!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LATEST", {
{"basic", "LATEST LATEST = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"stability", "LATEST DUP LATEST = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"COMPILATION", {
{
"here_comma_sequence", "HERE 10 , 20 , 30 , HERE SWAP - 12 = . CR", "Should advance HERE by 12",
TEST_NORMAL, 0, 1, {0}
},
{
"mixed_compilation", "HERE 42 , 65 C, 100 200 2, HERE SWAP - 13 = . CR", "Should advance correctly",
TEST_NORMAL, 0, 1, {0}
}, // MAY FAIL on non-4-byte platforms
{
"allot_comma_combo", "HERE 10 ALLOT 99 , HERE SWAP - 14 = . CR", "Should combine allot and comma",
TEST_NORMAL, 0, 1, {0}
},
{"pad_isolation", "PAD 999 OVER ! HERE 42 , PAD @ 999 = . CR", "PAD should be isolated", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"STACK_MGMT", {
{"sp_round_trip", "42 43 SP@ >R 44 45 R> SP! . . CR", "Should print: 43 42", TEST_NORMAL, 0, 1, {0}},
{
"depth_preservation", "1 2 3 DEPTH >R SP@ >R 4 5 6 R> SP! R> DEPTH = . CR", "Should preserve depth",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all dictionary word test suites
*
* @param vm Pointer to the FORTH virtual machine instance
*
* This function runs through all dictionary word test suites, including tests for:
* - HERE (dictionary pointer)
* - ALLOT (memory allocation)
* - Comma operations (, C, 2,)
* - PAD (scratch pad area)
* - Stack pointer operations (SP@ SP!)
* - LATEST (most recent dictionary entry)
* - Compilation sequences
* - Stack management operations
*/
void run_dictionary_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Dictionary Words Tests (Module 4)...");
for (int i = 0; dictionary_word_suites[i].word_name != NULL; i++) {
run_test_suite(vm, &dictionary_word_suites[i]);
}
print_module_summary("Dictionary Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/double_words_test.c
+346
View File
@@ -0,0 +1,346 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Double Number Words Test Suites - Module 6 */
static WordTestSuite double_word_suites[] = {
{
"2DROP", {
{"basic", "1 2 3 4 2DROP . . CR", "Should print: 1 2", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 42 99 2DROP . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -2 100 200 2DROP . . CR", "Should print: -1 -2", TEST_NORMAL, 0, 1, {0}},
{"exact_four", "10 20 30 40 2DROP DEPTH . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2DROP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 2DROP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2DUP", {
{"basic", "100 200 2DUP . . . . CR", "Should print: 100 200 100 200", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 2DUP . . . . CR", "Should print: 0 0 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 2DUP . . . . CR", "Should duplicate negatives", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "10 20 2DUP DEPTH . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 2DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2OVER", {
{"basic", "10 20 30 40 2OVER . . . . . . CR", "Should print: 10 20 30 40 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 99 88 2OVER . . . . . . CR", "Should print: 0 0 99 88 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 2 -3 4 2OVER . . . . . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 2OVER DEPTH . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 2OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2SWAP", {
{"basic", "10 20 30 40 2SWAP . . . . CR", "Should print: 30 40 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 99 88 2SWAP . . . . CR", "Should print: 99 88 0 0", TEST_NORMAL, 0, 1, {0}},
{"same_pairs", "42 42 42 42 2SWAP . . . . CR", "Should print: 42 42 42 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-10 -20 30 40 2SWAP . . . . CR", "Should print: 30 40 -10 -20", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 2SWAP DEPTH . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 2SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"2ROT", {
{"basic", "10 20 30 40 50 60 2ROT . . . . . . CR", "Should print: 30 40 50 60 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 1 1 2 2 2ROT . . . . . . CR", "Should rotate with zeros", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -2 3 4 -5 -6 2ROT . . . . . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 5 6 2ROT DEPTH . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"five_items", "1 2 3 4 5 2ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D+", {
{"basic", "100 200 300 400 D+ . . CR", "Should print: 400 600", TEST_NORMAL, 0, 1, {0}},
{"zero_add", "42 99 0 0 D+ . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 50 75 D+ . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"carry", "2147483647 0 1 0 D+ . . CR", "Should handle carry", TEST_EDGE_CASE, 0, 1, {0}},
{"both_negative", "-100 -200 -300 -400 D+ . . CR", "Should add negatives", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D-", {
{"basic", "500 600 100 200 D- . . CR", "Should print: 400 400", TEST_NORMAL, 0, 1, {0}},
{"zero_sub", "42 99 0 0 D- . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"from_zero", "0 0 100 200 D- . . CR", "Should print: -100 -200", TEST_NORMAL, 0, 1, {0}},
{"negative", "100 200 -50 -75 D- . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"borrow", "0 0 1 0 D- . . CR", "Should handle borrow", TEST_EDGE_CASE, 0, 1, {0}},
{"same_values", "100 200 100 200 D- . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"DNEGATE", {
{"positive", "100 200 DNEGATE . . CR", "Should negate positive double", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 DNEGATE . . CR", "Should negate negative double", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 DNEGATE . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"max_positive", "2147483647 0 DNEGATE . . CR", "Should negate max positive", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 DNEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DNEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DABS", {
{"positive", "100 200 DABS . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 DABS . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 DABS . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed_sign", "100 -1 DABS . . CR", "Should handle mixed sign", TEST_NORMAL, 0, 1, {0}},
{"min_double", "-2147483648 -1 DABS . . CR", "Should handle min double", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 DABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"DMIN", {
{"basic", "100 200 300 400 DMIN . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 99 42 99 DMIN . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 -50 -75 DMIN . . CR", "Should find min negative", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-100 -1 100 0 DMIN . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 DMIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DMIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DMAX", {
{"basic", "100 200 300 400 DMAX . . CR", "Should print: 300 400", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 99 42 99 DMAX . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-300 -400 -100 -200 DMAX . . CR", "Should find max negative", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-100 -1 100 0 DMAX . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 DMAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DMAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D=", {
{"equal", "100 200 100 200 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"not_equal_low", "100 200 101 200 D= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"not_equal_high", "100 200 100 201 D= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_equal", "0 0 0 0 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_equal", "-100 -200 -100 -200 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D<", {
{"less_than", "100 200 300 400 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"greater_than", "300 400 100 200 D< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"equal", "100 200 100 200 D< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_positive", "-100 -1 100 0 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-300 -1 -100 -1 D< . CR", "Should compare negatives", TEST_NORMAL, 0, 1, {0}},
{"high_word_diff", "100 200 100 300 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"D0=", {
{"zero", "0 0 D0= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"positive", "100 200 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_high", "0 100 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_low", "100 0 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 D0=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D0=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D0<", {
{"negative", "-100 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"positive", "100 0 D0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_high_only", "100 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"large_negative", "-1 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 D0<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D0<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"S>D", {
{"positive", "5 S>D . . CR", "Should sign-extend positive: 0 5", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 S>D . . CR", "Should sign-extend negative: -1 -5", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 S>D . . CR", "Should sign-extend zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 S>D . . CR", "Should extend max int: 0 2147483647", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 S>D . . CR","Should extend min int: -1 -2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "S>D", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D2*", {
{"basic", "5 0 D2* . . CR", "Should double 5: 0 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D2* . . CR", "Should double zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -1 D2* . . CR", "Should double -1: -1 -2", TEST_NORMAL, 0, 1, {0}},
{"carry", "0 1 D2* . . CR", "Should shift high cell: 0 2", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "D2*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"D2/", {
{"basic", "10 0 D2/ . . CR", "Should halve 10: 0 5", TEST_NORMAL, 0, 1, {0}},
{"negative", "-2 -1 D2/ . . CR", "Should halve -2: -1 -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D2/ . . CR", "Should halve zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"odd", "3 0 D2/ . . CR", "Should truncate toward zero: 0 1", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "D2/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
/* NOTE: 2>R/2R>/2R@ are tested at REPL level (not inside compiled words).
* The execution loop stores the IP in return_stack[rsp]; if 2>R were called
* inside a colon definition, it would increment rsp and the loop would
* dereference the pushed data value as a pointer — same model as >R tests. */
"2>R", {
{"roundtrip", "10 20 2>R 2R> . . CR", "Should store and retrieve: 20 10", TEST_NORMAL, 0, 1, {0}},
{"depth_after", "1 2 2>R DEPTH . 2R> DROP DROP CR", "Should empty data stack: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2>R", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"2R>", {
{"roundtrip", "5 6 2>R 2R> . . CR", "Should retrieve double: 6 5", TEST_NORMAL, 0, 1, {0}},
{"depth", "9 8 2>R 2R> DEPTH . CR", "Should push 2 items to data stack: 2", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack","2R>", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"2R@", {
{"peek", "3 4 2>R 2R@ . . 2R> DROP DROP CR", "Should peek: 4 3", TEST_NORMAL, 0, 1, {0}},
{"non_destructive", "7 8 2>R 2R@ DROP DROP 2R> . . CR", "Should leave rstack intact", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack", "2R@", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all test suites for double number words
*
* This function runs comprehensive tests for all double number word operations,
* including stack manipulation (2DROP, 2DUP, etc.), arithmetic operations (D+, D-, etc.),
* and comparison operations (D=, D<, etc.).
*
* @param vm Pointer to the virtual machine instance where tests will be executed
*/
void run_double_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Double Number Words Tests (Module 6)...");
for (int i = 0; double_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &double_word_suites[i]);
}
print_module_summary("Double Number Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/format_words_test.c
+170
View File
@@ -0,0 +1,170 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for format words (Module 10)
* Contains test cases for number base conversion and formatting operations
*/
static WordTestSuite format_word_suites[] = {
{
"BASE", {
{"decimal", "DECIMAL 42 . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"hex", "HEX FF . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"octal", "OCTAL 52 . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"base_store", "16 BASE ! 255 . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"base_fetch", "BASE @ . CR", "Should print current base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"DECIMAL", {
{"from_hex", "HEX FF DECIMAL . CR", "Should print: 255", TEST_NORMAL, 0, 1, {0}},
{"from_octal", "OCTAL 52 DECIMAL . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "DECIMAL 42 . CR 42 . CR HEX 42 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HEX", {
{"from_decimal", "DECIMAL 255 HEX . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"from_octal", "OCTAL 52 HEX . CR", "Should print: 2A", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "HEX FF . CR DECIMAL 255 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"OCTAL", {
{"from_decimal", "DECIMAL 42 OCTAL . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"from_hex", "HEX 2A OCTAL . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "DECIMAL 42 . CR OCTAL 52 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"<#", {
{"basic", "DECIMAL 42 S>D <# #S #> TYPE CR", "Should format number", TEST_NORMAL, 0, 1, {0}},
{"empty", "0 <# #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 <# #S #> TYPE CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#", {
{"single_digit", "15 <# # #> TYPE CR", "Should print rightmost digit", TEST_NORMAL, 0, 1, {0}},
{"multiple", "15 <# # # #> TYPE CR", "Should print digits right to left", TEST_NORMAL, 0, 1, {0}},
{"zero_pad", "5 <# # 0 # #> TYPE CR", "Should handle zero padding", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#S", {
{"basic", "42 <# #S #> TYPE CR", "Should convert all digits", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 <# #S #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"large", "1234567890 <# #S #> TYPE CR", "Should handle large numbers", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"SIGN", {
{"negative", "-42 ABS <# #S SIGN #> TYPE CR", "Should add minus", TEST_NORMAL, 0, 1, {0}},
{"positive", "42 <# #S SIGN #> TYPE CR", "Should not add sign", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 <# #S SIGN #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#>", {
{"normal", "42 <# #S #> TYPE CR", "Should terminate formatting", TEST_NORMAL, 0, 1, {0}},
{"empty", "0 <# #> TYPE CR", "Should handle empty format", TEST_NORMAL, 0, 1, {0}},
{"stack_effect", "42 <# #S #> SWAP . . CR", "Should leave addr u", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HOLD", {
{"basic", "42 <# 46 HOLD #S #> TYPE CR", "Should insert dot", TEST_NORMAL, 0, 1, {0}},
{"overflow", "<# 257 HOLD #>", "Should handle overflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all format words test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for number base manipulation and formatting words
*/
void run_format_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Format Words Tests (Module 10)...");
for (int i = 0; format_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &format_word_suites[i]);
}
print_module_summary("Format Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/inference_words_test.c
+139
View File
@@ -0,0 +1,139 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/*
* inference_words_test.c — POST tests for the SSM inference engine's
* proof-covered accessor/primitive words (Module 26)
*
* inference_words.c registers 20 words; only 8 are proof-covered per
* proof/COVERAGE.md ("5 accessors full; rest guard/shape") — this file
* covers exactly those 8, not the L8 Jacquard / Bayesian-posterior words,
* which COVERAGE.md does not claim coverage for. No test file existed for
* any word in this module before.
*
* The three array-based primitives (Q.VARIANCE/INFER-DECAY-SLOPE/
* INFER-WINDOW-WIDTH) need real data in VM memory — HERE is used as
* scratch, matching the idiom memory_words_test.c already uses. The four
* *-@ accessors and INFER-RUN are exercised in one suite (INFER-WINDOW@)
* that runs INFER-RUN first, since the accessors just read
* vm->last_inference_outputs and INFER-RUN is what populates it.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Inference Engine Words Test Suites - Module 26 */
static WordTestSuite inference_word_suites[] = {
{
"Q.VARIANCE", {
{"three_cells", "100 HERE ! 200 HERE 8 + ! 300 HERE 16 + ! HERE 3 Q.VARIANCE Q.TO-INT . CR",
"Should print population variance of {100,200,300} (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-DECAY-SLOPE", {
{"three_cells", "300 HERE ! 200 HERE 8 + ! 100 HERE 16 + ! HERE 3 INFER-DECAY-SLOPE Q.TO-INT . CR",
"Should print decay slope for a decreasing trajectory (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-WINDOW-WIDTH", {
{"three_cells", "100 HERE ! 200 HERE 8 + ! 300 HERE 16 + ! HERE 3 INFER-WINDOW-WIDTH . CR",
"Should print an inferred window width (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-RUN", {
{"basic", "INFER-RUN", "Should run without error", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-WINDOW@", {
{"after_run", "INFER-RUN INFER-WINDOW@ . CR", "Should print last adaptive_window_width (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-DECAY@", {
{"after_run", "INFER-RUN INFER-DECAY@ Q.TO-INT . CR", "Should print last adaptive_decay_slope (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-VARIANCE@", {
{"after_run", "INFER-RUN INFER-VARIANCE@ Q.TO-INT . CR", "Should print last window_variance_q48 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-FIT@", {
{"after_run", "INFER-RUN INFER-FIT@ Q.TO-INT . CR", "Should print last slope_fit_quality_q48 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-EARLY-EXIT@", {
{"after_run", "INFER-RUN INFER-EARLY-EXIT@ . CR", "Should print 0 or 1 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes the proof-covered subset of inference-engine word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Covers the 8 words proof/COVERAGE.md marks as proof-covered in
* inference_words.c: the three array-based primitives (Q.VARIANCE,
* INFER-DECAY-SLOPE, INFER-WINDOW-WIDTH), INFER-RUN, and the four
* *-@ output accessors (INFER-WINDOW@/DECAY@/VARIANCE@/FIT@) plus
* INFER-EARLY-EXIT@. Does not cover the L8 Jacquard or Bayesian
* posterior words in the same file — not claimed as proof-covered.
*/
void run_inference_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Inference Engine Words Tests (Module 26)...");
/* CONTRACT_NONE, not CONTRACT_PHYSICS_TRANSPARENT: these words read
* physics state (rolling window, dictionary heat) by design -- A4'
* transparency is a property they deliberately do not have. */
WordContract mod = {CONTRACT_NONE, 0};
for (int i = 0; inference_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &inference_word_suites[i], mod);
}
print_module_summary("Inference Engine Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/integration_tests.c
+233
View File
@@ -0,0 +1,233 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/**
* @file integration_tests.c
* @brief Full program integration tests for StarForth
*
* This file contains integration tests that verify complete Forth programs
* as regression tests. It includes test suites for complete programs,
* data structures, and algorithms implementations.
*/
#include "test_common.h"
#include "test_runner.h"
/* Integration test suites - complete Forth programs */
static WordTestSuite integration_suites[] = {
{
"COMPLETE_PROGRAMS", {
{
"prime_check",
": PRIME? ( n -- flag ) "
" DUP 2 < IF DROP 0 EXIT THEN "
" DUP 2 = IF DROP -1 EXIT THEN "
" DUP 2 MOD 0= IF DROP 0 EXIT THEN "
" DUP 3 DO "
" DUP I MOD 0= IF DROP 0 EXIT THEN "
" 2 +LOOP "
" DROP -1 "
"; "
"17 PRIME? . CR",
"Prime number checker",
TEST_NORMAL, 0, 1, {0}
},
{
"array_sum",
": ARRAY 5 CELLS ALLOT ; "
"ARRAY NUMS "
": STORE-NUMS "
" 10 NUMS 0 CELLS + ! "
" 20 NUMS 1 CELLS + ! "
" 30 NUMS 2 CELLS + ! "
" 40 NUMS 3 CELLS + ! "
" 50 NUMS 4 CELLS + ! "
"; "
": SUM-NUMS "
" 0 5 0 DO "
" NUMS I CELLS + @ + "
" LOOP "
"; "
"STORE-NUMS SUM-NUMS . CR",
"Array sum program",
TEST_NORMAL, 0, 1, {0}
},
{
"fizzbuzz_mini",
": FIZZ? 3 MOD 0= ; "
": BUZZ? 5 MOD 0= ; "
": FIZZBUZZ "
" DUP FIZZ? OVER BUZZ? AND IF DROP .\" FizzBuzz \" EXIT THEN "
" DUP FIZZ? IF DROP .\" Fizz \" EXIT THEN "
" DUP BUZZ? IF DROP .\" Buzz \" EXIT THEN "
" . "
"; "
"15 FIZZBUZZ CR",
"FizzBuzz for 15",
TEST_NORMAL, 0, 1, {0}
},
{
"calculator",
": + DEPTH 2 < IF .\" Stack underflow\" CR EXIT THEN + ; "
": CALC "
" 5 3 + "
" 2 * "
" 4 - "
" . CR "
"; "
"CALC",
"Simple calculator",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"DATA_STRUCTURES", {
{
"linked_list",
"VARIABLE HEAD "
"0 HEAD ! "
": NODE ( value -- addr ) "
" HERE "
" , " /* value */
" HEAD @ , " /* next pointer */
" DUP HEAD ! "
"; "
": PRINT-LIST ( -- ) "
" HEAD @ "
" BEGIN DUP WHILE "
" DUP @ . "
" CELL+ @ "
" REPEAT DROP CR "
"; "
"10 NODE DROP "
"20 NODE DROP "
"30 NODE DROP "
"PRINT-LIST",
"Simple linked list",
TEST_NORMAL, 0, 1, {0}
},
{
"stack_min_max",
": INIT-MINMAX "
" 2147483647 VARIABLE MIN " /* Max int */
" -2147483648 VARIABLE MAX " /* Min int */
"; "
": UPDATE-MINMAX ( n -- ) "
" DUP MIN @ < IF DUP MIN ! ELSE DROP THEN "
" DUP MAX @ > IF DUP MAX ! ELSE DROP THEN "
"; "
"INIT-MINMAX "
"42 UPDATE-MINMAX "
"17 UPDATE-MINMAX "
"99 UPDATE-MINMAX "
"MIN @ . MAX @ . CR",
"Min/Max tracker",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"ALGORITHMS", {
{
"bubble_sort_concept",
": SWAP-IF-NEEDED ( addr1 addr2 -- ) "
" OVER @ OVER @ > IF "
" OVER @ OVER @ "
" ROT ! SWAP ! "
" ELSE 2DROP THEN "
"; "
"VARIABLE A "
"VARIABLE B "
"5 A ! 3 B ! "
"A B SWAP-IF-NEEDED "
"A @ . B @ . CR",
"Swap if needed (sort helper)",
TEST_NORMAL, 0, 1, {0}
},
{
"gcd",
": GCD ( a b -- gcd ) "
" BEGIN DUP WHILE "
" TUCK MOD "
" REPEAT DROP "
"; "
"48 18 GCD . CR",
"Greatest Common Divisor",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
};
/**
* @brief Executes all integration test suites for StarForth
*
* @param vm Pointer to the Forth virtual machine instance
*
* This function runs through all defined integration test suites, including:
* - Complete Programs suite (prime checker, array operations, etc)
* - Data Structures suite (linked list, min/max tracker)
* - Algorithms suite (sorting, GCD)
*/
void run_integration_tests(VM *vm) {
if (!vm) return;
log_message(LOG_INFO, "==============================================");
log_message(LOG_INFO, " StarForth Integration Test Suite");
log_message(LOG_INFO, " Complete Forth Programs");
log_message(LOG_INFO, "==============================================\n");
for (size_t i = 0; i < sizeof(integration_suites) / sizeof(WordTestSuite); i++) {
run_test_suite(vm, &integration_suites[i]);
}
log_message(LOG_INFO, "\n==============================================");
log_message(LOG_INFO, " Integration Tests Complete");
log_message(LOG_INFO, "==============================================\n");
}
v3/src/test_runner/modules/io_words_test.c
+285
View File
@@ -0,0 +1,285 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for I/O words (Module 9)
* @details Contains comprehensive test cases for all I/O related FORTH words
* including output formatting, character I/O, and base conversion operations
*/
static WordTestSuite io_word_suites[] = {
{
".", {
{"positive", "42 . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 . CR", "Should print: -42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 . CR", "Should print: 2147483647", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 . CR", "Should print: -2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"multiple", "1 2 3 . . . CR", "Should print: 3 2 1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", ".", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"CR", {
{"basic", "42 . CR 43 . CR", "Should print on separate lines", TEST_NORMAL, 0, 1, {0}},
{"multiple", "CR CR CR", "Should print multiple newlines", TEST_NORMAL, 0, 1, {0}},
{"no_stack_effect", "DEPTH CR DEPTH = . CR", "Should not affect stack", TEST_NORMAL, 0, 1, {0}},
{"after_output", "1 2 3 . . . CR", "Should work after output", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SPACE", {
{"basic", "42 . SPACE 43 . CR", "Should add space between numbers", TEST_NORMAL, 0, 1, {0}},
{"multiple", "SPACE SPACE SPACE", "Should print multiple spaces", TEST_NORMAL, 0, 1, {0}},
{"no_stack_effect", "DEPTH SPACE DEPTH = . CR", "Should not affect stack", TEST_NORMAL, 0, 1, {0}},
{"with_text", "65 EMIT SPACE 66 EMIT CR", "Should space between chars", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SPACES", {
{"zero", "0 SPACES", "Should print no spaces", TEST_NORMAL, 0, 1, {0}},
{"one", "1 SPACES", "Should print one space", TEST_NORMAL, 0, 1, {0}},
{"multiple", "5 SPACES", "Should print five spaces", TEST_NORMAL, 0, 1, {0}},
{"large", "20 SPACES", "Should print twenty spaces", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 SPACES", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"with_output", "42 . 3 SPACES 43 . CR", "Should space output", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "SPACES", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"EMIT", {
{"letter_A", "65 EMIT CR", "Should print: A", TEST_NORMAL, 0, 1, {0}},
{"letter_Z", "90 EMIT CR", "Should print: Z", TEST_NORMAL, 0, 1, {0}},
{"digit", "48 EMIT CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"space_char", "32 EMIT CR", "Should print space", TEST_NORMAL, 0, 1, {0}},
{"newline", "10 EMIT", "Should print newline", TEST_NORMAL, 0, 1, {0}},
{"high_ascii", "127 EMIT CR", "Should print DEL char", TEST_NORMAL, 0, 1, {0}},
{"truncation", "321 EMIT CR", "Should truncate to low byte", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 EMIT CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"sequence", "72 EMIT 73 EMIT 10 EMIT", "Should print: HI", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "EMIT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
10, {0}
},
{
"KEY", {
{"basic_test", "KEY DROP", "Should wait for keypress", TEST_NORMAL, 0, 0, {0}},
{"echo_test", "KEY DUP EMIT CR", "Should echo keypresses", TEST_NORMAL, 0, 0, {0}},
{"multiple", "KEY KEY KEY DROP DROP DROP", "Should read multiple keys", TEST_NORMAL, 0, 0, {0}},
{"no_stack_underflow", "KEY . CR", "Should push key to stack", TEST_NORMAL, 0, 0, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"?KEY", {
{"available_test", "?KEY . CR", "Should test key availability", TEST_NORMAL, 0, 0, {0}},
{"no_wait", "?KEY IF KEY EMIT THEN CR", "Should not wait", TEST_NORMAL, 0, 0, {0}},
{"multiple_check", "?KEY ?KEY OR . CR", "Should check availability", TEST_NORMAL, 0, 0, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"TYPE", {
{
"basic_string", "HERE S\" Hello\" DUP >R HERE SWAP CMOVE HERE R> TYPE CR", "Should print: Hello",
TEST_NORMAL, 0, 1, {0}
},
{"empty_string", "HERE 0 TYPE CR", "Should print nothing", TEST_NORMAL, 0, 1, {0}},
{"single_char", "HERE 65 OVER C! 1 TYPE CR", "Should print: A", TEST_NORMAL, 0, 1, {0}},
{
"numbers", "HERE S\" 12345\" DUP >R HERE SWAP CMOVE HERE R> TYPE CR", "Should print: 12345",
TEST_NORMAL, 0, 1, {0}
},
{"zero_length", "PAD 0 TYPE", "Should handle zero length", TEST_NORMAL, 0, 1, {0}},
{"one_item", "PAD TYPE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "TYPE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"COUNT", {
{
"basic", "HERE S\" Test\" DROP C@ HERE 1+ SWAP COUNT . . CR", "Should show length and addr+1",
TEST_NORMAL, 0, 1, {0}
},
{"empty", "HERE 0 OVER C! COUNT . . CR", "Should handle empty string", TEST_NORMAL, 0, 1, {0}},
{"max_length", "HERE 255 OVER C! COUNT . . CR", "Should handle max length", TEST_NORMAL, 0, 1, {0}},
{"zero_addr_plus_one", "HERE COUNT SWAP 1- = . CR", "Should increment address", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "COUNT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"EXPECT", {
{"basic_input", "PAD 10 EXPECT", "Should read up to 10 chars", TEST_NORMAL, 0, 0, {0}},
{"max_length", "PAD 80 EXPECT", "Should read up to 80 chars", TEST_NORMAL, 0, 0, {0}},
{"zero_length", "PAD 0 EXPECT", "Should handle zero length", TEST_NORMAL, 0, 1, {0}},
{"one_item", "PAD EXPECT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "EXPECT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"SPAN", {
{"after_expect", "PAD 10 EXPECT SPAN @ . CR", "Should show chars read", TEST_NORMAL, 0, 0, {0}},
{"zero_input", "PAD 0 EXPECT SPAN @ . CR", "Should show zero", TEST_NORMAL, 0, 1, {0}},
{"variable_test", "SPAN @ SPAN @ = . CR", "Should be consistent", TEST_NORMAL, 0, 1, {0}},
{"address_test", "SPAN 0<> . CR", "Should be valid address", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"WORD", {
/* Basic functionality */
{"basic_parse", "BL WORD COUNT TYPE CR", "Should parse next word", TEST_NORMAL, 0, 0, {0}},
{"delimiter_test", "44 WORD COUNT TYPE CR", "Should use comma delimiter", TEST_NORMAL, 0, 0, {0}},
{"empty_input", "BL WORD COUNT . CR", "Should handle empty input", TEST_NORMAL, 0, 1, {0}},
/* Different delimiters */
{"space_delim", "32 WORD DROP", "Should use space as delimiter", TEST_NORMAL, 0, 1, {0}},
{"newline_delim", "10 WORD DROP", "Should use newline as delimiter", TEST_NORMAL, 0, 1, {0}},
{"tab_delim", "9 WORD DROP", "Should use tab as delimiter", TEST_NORMAL, 0, 1, {0}},
{"comma_delim", "44 WORD DROP", "Should use comma as delimiter", TEST_NORMAL, 0, 1, {0}},
/* Leading delimiters */
{"skip_leading", "BL WORD DROP", "Should skip leading spaces", TEST_NORMAL, 0, 1, {0}},
/* Word length tests */
{"single_char", "BL WORD COUNT . CR", "Should parse single character", TEST_NORMAL, 0, 1, {0}},
{"long_word", "BL WORD COUNT 0 > . CR", "Should parse long word", TEST_NORMAL, 0, 1, {0}},
/* Edge cases */
{"zero_delim", "0 WORD DROP", "Should handle null delimiter", TEST_NORMAL, 0, 1, {0}},
{"high_ascii", "127 WORD DROP", "Should handle DEL delimiter", TEST_NORMAL, 0, 1, {0}},
/* Count-prefixed string */
{"count_format", "BL WORD C@ . CR", "Should have count byte", TEST_NORMAL, 0, 1, {0}},
{"count_value", "BL WORD COUNT SWAP DROP . CR", "Should return count", TEST_NORMAL, 0, 1, {0}},
/* Error cases */
{"empty_stack", "WORD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
/* Consecutive delimiters */
{"multi_delim", "BL WORD DROP BL WORD DROP", "Should handle multiple parses", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
17, {0}
},
/* Base conversion and formatting tests */
{
"BASE_OUTPUT", {
{"decimal", "10 BASE ! 255 . CR", "Should print: 255", TEST_NORMAL, 0, 1, {0}},
{"hex", "16 BASE ! 255 . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"octal", "8 BASE ! 64 . CR", "Should print: 100", TEST_NORMAL, 0, 1, {0}},
{"binary", "5 2 BASE ! . CR", "Should print: 101", TEST_NORMAL, 0, 1, {0}},
{
"base_restore", "BASE @ DECIMAL 255 16 BASE ! . BASE ! CR", "Should restore base", TEST_NORMAL, 0,
1, {0}
},
{"reset_decimal", "DECIMAL", "Reset base to DECIMAL for subsequent tests", TEST_NORMAL, 0, 0, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
/* Output formatting combinations */
{
"FORMAT_COMBO", {
{"number_space_number", "DECIMAL 42 . SPACE 43 . CR", "Should format: 42 43", TEST_NORMAL, 0, 1, {0}},
{"multi_line", "DECIMAL 1 . CR 2 . CR 3 . CR", "Should print on separate lines", TEST_NORMAL, 0, 1, {0}},
{"indented", "DECIMAL 5 SPACES 42 . CR", "Should indent number", TEST_NORMAL, 0, 1, {0}},
{"table_format", "DECIMAL 1 . 3 SPACES 10 . 3 SPACES 100 . CR", "Should format table", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all I/O words test suites
* @param vm Pointer to the FORTH virtual machine instance
* @details Runs through all defined test suites for I/O words, logging results_run_01_2025_12_08
* and providing a summary of the test execution
*/
void run_io_words_tests(VM *vm) {
log_message(LOG_INFO, "Running I/O Words Tests (Module 9)...");
for (int i = 0; io_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &io_word_suites[i]);
}
print_module_summary("I/O Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/logical_words_test.c
+306
View File
@@ -0,0 +1,306 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Logical Words Test Suites - Module 8 */
static WordTestSuite logical_word_suites[] = {
{
"AND", {
{"both_true", "-1 -1 AND . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"first_false", "0 -1 AND . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"second_false", "-1 0 AND . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"both_false", "0 0 AND . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"bitwise", "85 51 AND . CR", "Should print: 17", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "AND", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 AND", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"OR", {
{"both_true", "-1 -1 OR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"first_false", "0 -1 OR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"second_false", "-1 0 OR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"both_false", "0 0 OR . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"bitwise", "85 51 OR . CR", "Should print: 119", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "OR", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 OR", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"XOR", {
{"both_true", "-1 -1 XOR . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"first_false", "0 -1 XOR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"second_false", "-1 0 XOR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"both_false", "0 0 XOR . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"bitwise", "85 51 XOR . CR", "Should print: 102", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "XOR", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 XOR", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"NOT", {
{"true", "-1 NOT . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"false", "0 NOT . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"positive", "42 NOT . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 NOT . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "NOT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"=", {
{"equal", "42 42 = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"not_equal", "42 43 = . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_equal", "0 0 = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_equal", "-42 -42 = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_positive", "-42 42 = . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 =", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"<>", {
{"not_equal", "42 43 <> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 42 <> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_equal", "0 0 <> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 42 <> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "<>", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 <>", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"<", {
{"less_than", "5 7 < . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"greater_than", "7 5 < . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"equal", "5 5 < . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_positive", "-5 5 < . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-7 -5 < . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 <", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
">", {
{"greater_than", "7 5 > . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"less_than", "5 7 > . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"equal", "5 5 > . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"positive_negative", "5 -5 > . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-5 -7 > . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", ">", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 >", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"0=", {
{"zero", "0 0= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"positive", "42 0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "0=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"0<", {
{"negative", "-42 0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"positive", "42 0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "0<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"0>", {
{"positive", "42 0> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 0> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "0>", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"0<>", {
{"nonzero_pos", "42 0<> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"nonzero_neg", "-1 0<> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0<> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "0<>", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"U<", {
{"less", "3 5 U< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"equal", "5 5 U< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"greater", "7 5 U< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_one", "0 1 U< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "U<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"U>", {
{"greater", "5 3 U> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"equal", "5 5 U> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"less", "3 5 U> . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"one_zero", "1 0 U> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "U>", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"WITHIN", {
{"in_range", "3 1 5 WITHIN . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"at_low", "1 1 5 WITHIN . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"at_high", "5 1 5 WITHIN . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"below", "0 1 5 WITHIN . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"above", "6 1 5 WITHIN . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "WITHIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"TRUE", {
{"value", "TRUE . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"as_flag", "TRUE 0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"in_and", "TRUE TRUE AND . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"FALSE", {
{"value", "FALSE . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"as_flag", "FALSE 0= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"in_or", "TRUE FALSE OR . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
">=", {
{"less", "3 5 >= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"greater", "5 3 >= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"equal", "3 3 >= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 0 >= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"neg_neg", "-1 -2 >= . CR","Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"underflow", ">=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"<=", {
{"less", "3 5 <= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"greater", "5 3 <= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"equal", "3 3 <= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 0 <= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"neg_neg", "-2 -1 <= . CR","Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"underflow", "<=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all logical words test suites
*
* This function runs comprehensive tests for all FORTH logical and comparison operators,
* including stack underflow checks and edge cases.
*
* @param vm Pointer to the FORTH virtual machine instance
*/
void run_logical_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Logical Words Tests (Module 8)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; logical_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &logical_word_suites[i], mod);
}
print_module_summary("Logical Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/mama_forth_words_test.c
+274
View File
@@ -0,0 +1,274 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/**
* @file mama_forth_words_test.c
* @brief Test module for Mama FORTH vocabulary (M7.1 Capsule System)
*
* Tests for the MAMA vocabulary words. These words are kernel-only
* (__STARKERNEL__), so in hosted builds all tests are marked as
* not implemented and will be skipped.
*
* In kernel builds, these tests validate:
* - Capsule directory enumeration
* - Descriptor field access
* - VM birth protocol
* - Experiment execution
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/*
* Mama FORTH words (CAPSULE-COUNT etc.) are kernel runtime objects, not
* FORTH dictionary words. They do not live in the StarForth dictionary,
* so there is nothing to test via vm_interpret. Mark all tests skipped.
*/
#define MAMA_IMPLEMENTED 0
/* Mama FORTH Words Test Suites */
static WordTestSuite mama_word_suites[] = {
{
"CAPSULE-COUNT",
{
{
"basic",
"CAPSULE-COUNT . CR",
"Should print number of capsules",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"non_negative",
"CAPSULE-COUNT 0 >= . CR",
"Should be >= 0",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CAPSULE@",
{
{
"first_capsule",
"0 CAPSULE@ . CR",
"Should return first descriptor address",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"out_of_bounds",
"9999 CAPSULE@ . CR",
"Should return 0 for invalid index",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"empty_stack",
"CAPSULE@",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CAPSULE-FLAGS@",
{
{
"basic",
"0 CAPSULE@ CAPSULE-FLAGS@ . CR",
"Should return flags from descriptor",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"null_desc",
"0 CAPSULE-FLAGS@ . CR",
"Should handle null descriptor",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"empty_stack",
"CAPSULE-FLAGS@",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CAPSULE-LEN@",
{
{
"basic",
"0 CAPSULE@ CAPSULE-LEN@ . CR",
"Should return payload length",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"empty_stack",
"CAPSULE-LEN@",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CAPSULE-HASH@",
{
{
"basic",
"0 CAPSULE@ CAPSULE-HASH@ . CR",
"Should return content hash",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"empty_stack",
"CAPSULE-HASH@",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"MAMA-VM-ID",
{
{
"always_zero",
"MAMA-VM-ID . CR",
"Should always print 0",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"equals_zero",
"MAMA-VM-ID 0 = . CR",
"Should equal 0",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"VM-COUNT",
{
{
"at_least_one",
"VM-COUNT . CR",
"Should be at least 1 (Mama)",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"positive",
"VM-COUNT 0 > . CR",
"Should be positive",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CAPSULE-BIRTH",
{
{
"invalid_id",
"9999999 CAPSULE-BIRTH . CR",
"Should return -1 for invalid capsule ID",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{
"empty_stack",
"CAPSULE-BIRTH",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CAPSULE-RUN",
{
{
"empty_stack",
"CAPSULE-RUN",
"Should cause stack underflow",
TEST_ERROR_CASE, 1, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"CAPSULE-TEST",
{
{
"basic",
"CAPSULE-TEST",
"Should print diagnostic message",
TEST_NORMAL, 0, MAMA_IMPLEMENTED, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}} /* End marker */
};
/**
* @brief Executes all Mama FORTH vocabulary test suites
*
* In hosted builds, all tests will be skipped since MAMA_IMPLEMENTED=0.
* In kernel builds, tests will execute against the capsule system.
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_mama_forth_words_tests(VM *vm)
{
log_message(LOG_INFO, "Running Mama FORTH Words Tests (Capsule System M7.1)...");
#ifndef __STARKERNEL__
log_message(LOG_INFO, " (Hosted build - Mama words not available, tests will be skipped)");
#endif
for (int i = 0; mama_word_suites[i].word_name != NULL; i++) {
run_test_suite(vm, &mama_word_suites[i]);
}
print_module_summary("Mama FORTH Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/memory_words_test.c
+240
View File
@@ -0,0 +1,240 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Memory Words Test Suites - Module 3 */
static WordTestSuite memory_word_suites[] = {
{
"!", {
{"basic", "42 HERE ! HERE @ . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 HERE ! HERE @ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-999 HERE ! HERE @ . CR", "Should print: -999", TEST_NORMAL, 0, 1, {0}},
{"overwrite", "111 HERE ! 222 HERE ! HERE @ . CR", "Should print: 222", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 HERE ! HERE @ . CR", "Should store max int", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 HERE ! HERE @ . CR", "Should store min int", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 !", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"@", {
{"after_store", "123 HERE ! HERE @ . CR", "Should print: 123", TEST_NORMAL, 0, 1, {0}},
{"multiple_reads", "456 HERE ! HERE @ HERE @ = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "@", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"C!", {
{"basic", "65 HERE C! HERE C@ . CR", "Should print: 65", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 HERE C! HERE C@ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"high_byte", "255 HERE C! HERE C@ . CR", "Should print: 255", TEST_NORMAL, 0, 1, {0}},
{"truncation", "256 HERE C! HERE C@ . CR", "Should print: 0 (truncated)", TEST_EDGE_CASE, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"C@", {
{"after_cstore", "97 HERE C! HERE C@ . CR", "Should print: 97", TEST_NORMAL, 0, 1, {0}},
{"zero_byte", "0 HERE C! HERE C@ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
",", {
{"basic", "42 , HERE 8 - @ . CR", "Should compile 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-999 , HERE 8 - @ . CR", "Should compile -999", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"C,", {
{"basic", "65 C, HERE 1 - C@ . CR", "Should compile byte 65", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 C, HERE 1 - C@ . CR", "Should compile byte 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"2,", {
{
"roundtrip", "12345 67890 2, HERE 16 - 2@ . . CR", "Should print: 67890 12345",
TEST_NORMAL, 0, 1, {0}
},
{
"save-and-verify", "12345 67890 2, HERE 16 - 2@ 67890 = SWAP 12345 = AND . CR",
"Should print: -1", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"HERE", {
{"basic", "HERE HERE = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"after_comma", "HERE 42 , HERE SWAP - 1 CELLS = 0 SWAP /", "Asserts HERE advances by exactly 1 CELLS (8 bytes on 64-bit)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"ALLOT", {
{"basic", "HERE 10 ALLOT HERE SWAP - . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "HERE 0 ALLOT HERE SWAP - . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "HERE -4 ALLOT HERE SWAP - . CR", "Should print: -4", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"PAD", {
{"basic", "PAD PAD = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"different_from_here", "PAD HERE = . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"+!", {
{"basic", "10 HERE ! 5 HERE +! HERE @ . CR", "Should print: 15", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 HERE ! 0 HERE +! HERE @ . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "10 HERE ! -3 HERE +! HERE @ . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"accumulate", "0 HERE ! 1 HERE +! 2 HERE +! 3 HERE +! HERE @ . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "+!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"-!", {
{"basic", "10 HERE ! 3 HERE -! HERE @ . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 HERE ! 0 HERE -! HERE @ . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "10 HERE ! -5 HERE -! HERE @ . CR", "Should print: 15", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "-!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"2!", {
{"basic", "11 22 HERE 2! HERE @ . HERE 8 + @ . CR", "Should print: 22 11", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 HERE 2! HERE @ . HERE 8 + @ . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -2 HERE 2! HERE @ . HERE 8 + @ . CR", "Should print: -2 -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"FILL", {
{"basic", "HERE 8 65 FILL HERE C@ . HERE 1+ C@ . CR", "Should print: 65 65", TEST_NORMAL, 0, 1, {0}},
{"zero_n", "HERE 0 88 FILL", "Should do nothing", TEST_NORMAL, 0, 1, {0}},
{"zero_byte", "HERE 4 0 FILL HERE C@ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "FILL", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"MOVE", {
{"basic", "HERE 65 OVER C! HERE 1+ 66 OVER C! HERE HERE 16 + 2 MOVE HERE 16 + C@ . HERE 17 + C@ . CR", "Should print: 65 66", TEST_NORMAL, 0, 1, {0}},
{"zero_n", "HERE HERE 8 + 0 MOVE", "Should do nothing", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "MOVE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"ERASE", {
{"basic", "HERE 4 65 FILL HERE 4 ERASE HERE C@ . HERE 3 + C@ . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"zero_n", "HERE 0 ERASE", "Should do nothing", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "ERASE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes the test suite for memory manipulation words
* @details Runs through a series of test cases for Forth memory operations including
* store, fetch, allot, and other memory-related words
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_memory_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Memory Words Tests (Module 3)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; memory_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &memory_word_suites[i], mod);
}
print_module_summary("Memory Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/mixed_arithmetic_words_test.c
+162
View File
@@ -0,0 +1,162 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Module 7 test-suite table for mixed-arithmetic FORTH-79 words.
*
* Covers the five combined multiply-divide words: @c *-/ , @c *-/MOD ,
* @c M+ , @c M* , and @c M/MOD . Each suite exercises normal cases,
* edge cases (overflow, large products), and error cases (division by
* zero, stack underflow). The table is terminated with a NULL sentinel.
*/
static WordTestSuite mixed_arithmetic_word_suites[] = {
{
"*/", {
// ( n1 n2 n3 -- n4 ) n1 * n2 / n3 (integer math)
{"basic", "6 7 4 */ . CR", "Should print: 10 (6*7/4)", TEST_NORMAL, 0, 1, {0}},
{"exact_division", "12 5 3 */ . CR", "Should print: 20 (12*5/3)", TEST_NORMAL, 0, 1, {0}},
{"zero_multiply", "0 999 123 */ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 5 1 */ . CR", "Should print: 210 (42*5/1)", TEST_NORMAL, 0, 1, {0}},
{"truncation", "7 3 2 */ . CR", "Should print: 10 (21/2 truncated)", TEST_NORMAL, 0, 1, {0}},
{"negative_multiply", "-6 7 4 */ . CR", "Should print: -10", TEST_NORMAL, 0, 1, {0}},
{"negative_divisor", "6 7 -4 */ . CR", "Should print: -10", TEST_NORMAL, 0, 1, {0}},
{"div_by_zero", "6 7 0 */", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "*/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"two_items", "1 2 */", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
10, {0}
},
{
"*/MOD", {
// ( n1 n2 n3 -- rem quot ) (n1*n2)/n3 -> quot, rem
{"basic", "17 3 5 */MOD . . CR", "Should print: 1 10 (51/5 = 10 rem 1)", TEST_NORMAL, 0, 1, {0}},
{"exact_division", "15 4 3 */MOD . . CR", "Should print: 0 20 (60/3 = 20 rem 0)", TEST_NORMAL, 0, 1, {0}},
{"zero_multiply", "0 999 123 */MOD . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 5 1 */MOD . . CR", "Should print: 0 210", TEST_NORMAL, 0, 1, {0}},
{"remainder", "7 8 5 */MOD . . CR", "Should print: 1 11 (56/5 = 11 rem 1)", TEST_NORMAL, 0, 1, {0}},
{"negative", "-7 3 4 */MOD . . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"div_by_zero", "6 7 0 */MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "*/MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"M+", {
// ( d_lo d_hi n -- d_lo' d_hi' ) Add n to double d (low first, then high, then n)
{"basic", "0 100 200 M+ . . CR", "Should print: 200 100", TEST_NORMAL, 0, 1, {0}},
{"overflow", "0 2147483647 1 M+ . . CR", "Should handle overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"negative", "0 -100 50 M+ . . CR", "Should print: 50 -100", TEST_NORMAL, 0, 1, {0}},
{"zero_add", "0 42 0 M+ . . CR", "Should print: 0 42", TEST_NORMAL, 0, 1, {0}},
{"both_negative", "0 -100 -200 M+ . . CR", "Should print: -200 -100", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "M+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 M+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"M*", {
// ( n1 n2 -- d_lo d_hi ) signed multiply, returns double (lo first, hi second)
{"basic", "123 456 M* . . CR", "Should print: 56088 0", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "999 0 M* . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 M* . . CR", "Should print: 42 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-123 456 M* . . CR", "Should print: -56088 -1", TEST_NORMAL, 0, 1, {0}},
{"large_multiply", "65536 65536 M* . . CR", "Should handle large result", TEST_EDGE_CASE, 0, 1, {0}},
{"both_negative", "-100 -200 M* . . CR", "Should print: 20000 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "M*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 M*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"M/MOD", {
// ( d_lo d_hi n -- rem quot ) double/single signed division (lo first, then hi, then n)
{"basic", "0 1000 100 M/MOD . . CR", "Should print: 0 10 (1000/100)", TEST_NORMAL, 0, 1, {0}},
{"with_remainder", "0 1234 100 M/MOD . . CR", "Should handle remainder", TEST_NORMAL, 0, 1, {0}},
{"double_dividend", "5001 0 10 M/MOD . . CR", "Should print: 1 500 (5001/10)", TEST_NORMAL, 0, 1, {0}},
{"by_one", "0 42 1 M/MOD . . CR", "Should print: 0 42", TEST_NORMAL, 0, 1, {0}},
{"negative_dividend", "-1 1000 100 M/MOD . . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"div_by_zero", "0 100 0 M/MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "M/MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Module 7 entry point — run all mixed-arithmetic word POST tests.
*
* Iterates @c mixed_arithmetic_word_suites and delegates each to
* @c run_test_suite(). Covers five word families:
*
* - @c *-/ ( n1 n2 n3 -- n4 ) — scale: n1*n2/n3 in 64-bit intermediate
* - @c *-/MOD ( n1 n2 n3 -- rem quot ) — scale with remainder
* - @c M+ ( d n -- d' ) — add single to double
* - @c M* ( n1 n2 -- d ) — signed multiply to double
* - @c M/MOD ( d n -- rem quot ) — double divided by single
*
* @param vm VM instance; must be initialised with the standard vocabulary.
*/
void run_mixed_arithmetic_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Mixed Arithmetic Words Tests (Module 7)...");
for (int i = 0; mixed_arithmetic_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &mixed_arithmetic_word_suites[i]);
}
print_module_summary("Mixed Arithmetic Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/physics_freeze_words_test.c
+127
View File
@@ -0,0 +1,127 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/*
* physics_freeze_words_test.c — POST tests for the proof-covered subset of
* physics_freeze_words.c (Module 27)
*
* physics_freeze_words.c registers 9 words; proof/COVERAGE.md and
* proof/StarForth_Physics_Freeze_Words.thy give real (non-"True"-placeholder)
* lemmas for exactly 6 of them: FREEZE-WORD, UNFREEZE-WORD, FROZEN?, HEAT!,
* HEAT@, DECAY-RATE@. FREEZE-CRITICAL, SHOW-HEAT, and ALL-HEATS carry only
* trivial "not_modelled"/pass-through True lemmas, so they are intentionally
* left uncovered here (matches the 6/9 figure in COVERAGE.md). No test file
* for this module existed before.
*
* Each test case defines a scratch dictionary word (`:` ... `;`) and takes
* its name via S" — every word here operates on ( caddr u ), the standard
* counted-string-less pair the rest of the FORTH interpreter uses. Using
* `run_test_suite` (no WordContract) rather than `run_test_suite_m`, matching
* defining_words_tests.c's precedent: these test cases define dictionary
* words, and check_physics_transparent's own contract explicitly documents
* that its re-run mechanism does not snapshot/restore dictionary state.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Physics Freeze Words Test Suites - Module 27 */
static WordTestSuite physics_freeze_word_suites[] = {
{
"FREEZE-WORD", {
{"basic",
": __freeze_test_word__ ; S\" __freeze_test_word__\" FREEZE-WORD S\" __freeze_test_word__\" FROZEN? . CR",
"Should print: -1 (word is now frozen)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"UNFREEZE-WORD", {
{"basic",
": __unfreeze_test_word__ ; S\" __unfreeze_test_word__\" FREEZE-WORD S\" __unfreeze_test_word__\" UNFREEZE-WORD S\" __unfreeze_test_word__\" FROZEN? . CR",
"Should print: 0 (freeze cleared)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"FROZEN?", {
{"not_frozen",
": __frozen_test_word__ ; S\" __frozen_test_word__\" FROZEN? . CR",
"Should print: 0 (freshly defined word is not frozen)", TEST_NORMAL, 0, 1, {0}},
{"not_found",
"S\" __nonexistent_freeze_xyz__\" FROZEN? . CR",
"Should print: 0 (not-found treated as not frozen)", TEST_EDGE_CASE, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"HEAT!", {
{"basic",
": __heat_store_test_word__ ; 999 S\" __heat_store_test_word__\" HEAT! S\" __heat_store_test_word__\" HEAT@ . CR",
"Should print: 999", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"HEAT@", {
{"of_fresh_word",
": __heat_fetch_test_word__ ; S\" __heat_fetch_test_word__\" HEAT@ . CR",
"Should print: 0 (freshly defined word has zero heat)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"DECAY-RATE@", {
{"basic", "DECAY-RATE@ . CR",
"Should print the compile-time DECAY_RATE_PER_US_Q16 constant (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes the proof-covered subset of physics-freeze word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Covers the 6 words proof/StarForth_Physics_Freeze_Words.thy gives
* real lemmas for: FREEZE-WORD, UNFREEZE-WORD, FROZEN?, HEAT!,
* HEAT@, DECAY-RATE@. Does not cover FREEZE-CRITICAL, SHOW-HEAT, or
* ALL-HEATS — those carry only trivial/not-modelled lemmas in the
* same theory file.
*/
void run_physics_freeze_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Physics Freeze Words Tests (Module 27)...");
for (int i = 0; physics_freeze_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &physics_freeze_word_suites[i]);
}
print_module_summary("Physics Freeze Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/q48_words_test.c
+230
View File
@@ -0,0 +1,230 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/*
* q48_words_test.c — POST tests for Q48.16 fixed-point words (Module 25)
*
* Proof-covered per proof/COVERAGE.md (StarForth_Q48_Words.thy, 17/23) but
* had no interpreter-level POST coverage at all before this file — no test
* file for q48_words.c existed. Values are built with Q.FROM-INT/Q.1/Q.0
* and read back with Q.TO-INT so results print as plain readable integers;
* pass/fail itself is judged only by vm->error (matching every other
* WordTestSuite-based module), so exact printed values are for a human
* reading the log, not machine-verified — same convention arithmetic_words_
* test.c already uses for its own "Should print: N" fields.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Q48.16 Words Test Suites - Module 25 */
static WordTestSuite q48_word_suites[] = {
{
"Q.+", {
{"basic", "1 Q.FROM-INT 2 Q.FROM-INT Q.+ Q.TO-INT . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.-", {
{"basic", "5 Q.FROM-INT 2 Q.FROM-INT Q.- Q.TO-INT . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.*", {
{"basic", "3 Q.FROM-INT 4 Q.FROM-INT Q.* Q.TO-INT . CR", "Should print: 12", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q./", {
{"basic", "10 Q.FROM-INT 2 Q.FROM-INT Q./ Q.TO-INT . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "5 Q.FROM-INT 0 Q.FROM-INT Q./ Q.TO-INT . CR", "Should print: 0 (division by zero yields q=0)", TEST_EDGE_CASE, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"Q.ABS", {
{"basic", "3 Q.FROM-INT Q.NEG Q.ABS Q.TO-INT . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.NEG", {
{"basic", "5 Q.FROM-INT Q.NEG Q.TO-INT . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.LOG", {
{"of_one", "Q.1 Q.LOG Q.TO-INT . CR", "Should print: 0 (ln 1.0 = 0)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.EXP", {
{"of_zero", "Q.0 Q.EXP Q.TO-INT . CR", "Should print: 1 (e^0 = 1)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.SQRT", {
{"of_four", "4 Q.FROM-INT Q.SQRT Q.TO-INT . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.SIN", {
{"of_zero", "Q.0 Q.SIN Q.TO-INT . CR", "Should print: 0 (sin 0 = 0)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.COS", {
{"of_zero", "Q.0 Q.COS Q.TO-INT . CR", "Should print: 1 (cos 0 = 1)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.FROM-INT", {
{"round_trip", "7 Q.FROM-INT Q.TO-INT . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.TO-INT", {
{"of_one", "Q.1 Q.TO-INT . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.1", {
{"raw_value", "Q.1 . CR", "Should print: 65536", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.0", {
{"raw_value", "Q.0 . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.SCALE", {
{"raw_value", "Q.SCALE . CR", "Should print: 65536", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.=", {
{"equal", "Q.1 Q.1 Q.= . CR", "Should print: -1 (true)", TEST_NORMAL, 0, 1, {0}},
{"not_equal", "Q.1 Q.0 Q.= . CR", "Should print: 0 (false)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"Q.<", {
{"true", "Q.0 Q.1 Q.< . CR", "Should print: -1 (true)", TEST_NORMAL, 0, 1, {0}},
{"false", "Q.1 Q.0 Q.< . CR", "Should print: 0 (false)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"Q.>", {
{"true", "Q.1 Q.0 Q.> . CR", "Should print: -1 (true)", TEST_NORMAL, 0, 1, {0}},
{"false", "Q.0 Q.1 Q.> . CR", "Should print: 0 (false)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"Q.0=", {
{"true", "Q.0 Q.0= . CR", "Should print: -1 (true)", TEST_NORMAL, 0, 1, {0}},
{"false", "Q.1 Q.0= . CR", "Should print: 0 (false)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"Q.MAX", {
{"basic", "3 Q.FROM-INT 7 Q.FROM-INT Q.MAX Q.TO-INT . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.MIN", {
{"basic", "3 Q.FROM-INT 7 Q.FROM-INT Q.MIN Q.TO-INT . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"Q.PRINT", {
{"of_one", "Q.1 Q.PRINT CR", "Should print: 1.00000", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all Q48.16 fixed-point word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Covers all 23 words registered by register_q48_words()
* (q48_words.c): arithmetic (+, -, *, /), sign (ABS, NEG),
* transcendental approximations (LOG, EXP, SQRT, SIN, COS),
* conversions (FROM-INT, TO-INT), constants (1, 0, SCALE),
* comparisons (=, <, >, 0=, MAX, MIN), and PRINT.
*/
void run_q48_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Q48.16 Words Tests (Module 25)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; q48_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &q48_word_suites[i], mod);
}
print_module_summary("Q48.16 Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/return_stack_words_test.c
+104
View File
@@ -0,0 +1,104 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for return stack manipulation words
* @details Contains test cases for >R (push to return stack),
* R> (pop from return stack), and R@ (copy top of return stack)
*/
static WordTestSuite return_stack_word_suites[] = {
{
">R", {
{"basic", "42 >R R@ . R> . CR", "Should print: 42 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 >R R@ . R> . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-123 >R R@ . R> . CR", "Should print: -123 -123", TEST_NORMAL, 0, 1, {0}},
{"multiple", "1 2 >R >R R@ . R> . R@ . R> . CR", "Should print: 2 2 1 1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", ">R", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"R>", {
{"basic", "42 >R R> . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"lifo_order", "1 2 >R >R R> . R> . CR", "Should print: 2 1", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack", "R>", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"R@", {
{"basic", "42 >R R@ . R> DROP CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"non_destructive", "99 >R R@ R@ = . R> DROP CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack", "R@", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all test suites for return stack manipulation words
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all defined test cases for >R, R>, and R@ words
* and reports results_run_01_2025_12_08 through the logging system
*/
void run_return_stack_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Return Stack Words Tests (Module 2)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; return_stack_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &return_stack_word_suites[i], mod);
}
print_module_summary("Return Stack Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/stack_words_test.c
+215
View File
@@ -0,0 +1,215 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/**
* @file stack_words_test.c
* @brief Test module for Forth stack manipulation words
* @details Contains test suites for basic stack operations including
* DUP, DROP, SWAP, OVER, ROT, DEPTH, PICK, and ROLL
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for stack manipulation words
* @details Contains comprehensive test cases for all standard stack operations,
* including normal cases, edge cases, and error conditions
*/
static WordTestSuite stack_word_suites[] = {
{
"DUP", {
{"basic", "5 DUP . . CR", "Should print: 5 5", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 DUP . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 DUP . . CR", "Should print: -42 -42", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 DUP . . CR", "Should duplicate max int", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 DUP . . CR", "Should duplicate min int", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DROP", {
/* Basic functionality */
{"basic", "5 7 DROP . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"zero", "42 0 DROP . CR", "Should drop zero, print 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "10 -5 DROP . CR", "Should drop negative, print 10", TEST_NORMAL, 0, 1, {0}},
/* Multiple drops */
{"double_drop", "1 2 3 DROP DROP . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"triple_drop", "1 2 3 4 DROP DROP DROP . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"sequential", "5 DROP 6 DROP 7 . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
/* Stack depth effects */
{"single_item", "99 DROP DEPTH . CR", "Should empty stack, depth=0", TEST_NORMAL, 0, 1, {0}},
{"depth_change", "DEPTH 1 2 DROP DEPTH SWAP - . CR", "Should change depth by 1", TEST_NORMAL, 0, 1, {0}},
{"preserve_depth", "DEPTH 5 6 DROP DROP DEPTH = . CR", "Should preserve net depth", TEST_NORMAL, 0, 1, {0}},
/* Edge cases */
{"max_int", "2147483647 DROP DEPTH . CR", "Should drop max int", TEST_NORMAL, 0, 1, {0}},
{"min_int", "-2147483648 DROP DEPTH . CR", "Should drop min int", TEST_NORMAL, 0, 1, {0}},
/* Chaining with other operations */
{"with_dup", "5 DUP DROP . CR", "Should duplicate then drop", TEST_NORMAL, 0, 1, {0}},
{"with_swap", "1 2 SWAP DROP . CR", "Should swap then drop", TEST_NORMAL, 0, 1, {0}},
{"complex", "1 2 3 ROT DROP SWAP DROP . CR", "Should handle complex sequence", TEST_NORMAL, 0, 1, {0}},
/* Error case */
{"empty_stack", "DROP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
15, {0}
},
{
"SWAP", {
{"basic", "5 7 SWAP . . CR", "Should print: 7 5", TEST_NORMAL, 0, 1, {0}},
{"same_values", "42 42 SWAP . . CR", "Should print: 42 42", TEST_NORMAL, 0, 1, {0}},
{"zero_nonzero", "0 99 SWAP . . CR", "Should print: 99 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 10 SWAP . . CR", "Should print: 10 -5", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"OVER", {
{"basic", "5 7 OVER . . . CR", "Should print: 5 7 5", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 OVER . . . CR", "Should print: 0 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 42 OVER . . . CR", "Should print: -1 42 -1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ROT", {
{"basic", "1 2 3 ROT . . . CR", "Should print: 2 3 1", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 0 ROT . . . CR", "Should print: 0 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 0 1 ROT . . . CR", "Should print: 0 1 -1", TEST_NORMAL, 0, 1, {0}},
{"two_items", "1 2 ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DEPTH", {
{"empty", "DEPTH . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 DEPTH . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"multiple", "1 2 3 DEPTH . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"PICK", {
{"pick_0", "1 2 3 0 PICK . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"pick_1", "1 2 3 1 PICK . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"pick_2", "1 2 3 2 PICK . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"ROLL", {
{"roll_1", "1 2 3 1 ROLL . . . CR", "Should print: 1 3 2", TEST_NORMAL, 0, 1, {0}},
{"roll_2", "1 2 3 2 ROLL . . . CR", "Should print: 2 3 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"?DUP", {
{"nonzero", "42 ?DUP . . CR", "Should print: 42 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 ?DUP . . CR", "Should print: -5 -5", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 ?DUP DEPTH . CR", "Should not dup: depth 1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "?DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"-ROT", {
{"basic", "1 2 3 -ROT . . . CR", "Should print: 1 3 2", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 0 -ROT . . . CR", "Should print: 0 0 0", TEST_NORMAL, 0, 1, {0}},
{"roundtrip", "1 2 3 -ROT ROT . . . CR", "Should restore original order", TEST_NORMAL, 0, 1, {0}},
{"two_items", "1 2 -ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "-ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all test suites for stack manipulation words
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all defined test cases for stack manipulation words
* and reports results_run_01_2025_12_08 through the logging system
*/
void run_stack_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Stack Words Tests (Module 1: Foundation)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; stack_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &stack_word_suites[i], mod);
}
print_module_summary("Stack Words", 0, 0, 0, 0); /* Will be calculated by test_suite */
}
v3/src/test_runner/modules/starforth_words_test.c
+222
View File
@@ -0,0 +1,222 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for StarForth-specific words
*
* Contains test cases for the following StarForth implementation words:
* - ENTROPY@: Fetch word execution count
* - ENTROPY!: Store word execution count
* - WORD-ENTROPY: Get execution count for a word by name
* - RESET-ENTROPY: Reset all word execution counts
* - TOP-WORDS: Display most frequently executed words
* - (-: Comment to end of line
* - INIT: System initialization
*/
static WordTestSuite starforth_word_suites[] = {
{
"ENTROPY@", {
/* Basic functionality - ' returns xt (DictEntry*), NOT body address */
{
"after_execution", ": TESTWORD 1 1 + DROP ; TESTWORD ' TESTWORD ENTROPY@ . CR",
"Should show execution count > 0", TEST_NORMAL, 0, 1, {0}
},
{
"zero_initial", ": NEWWORD ; ' NEWWORD ENTROPY@ . CR",
"Should show 0 for unused word", TEST_NORMAL, 0, 1, {0}
},
/* Multiple executions */
{
"multiple_calls", ": ENTTEST 1 DROP ; ENTTEST ENTTEST ENTTEST ' ENTTEST ENTROPY@ . CR",
"Should increment with each call", TEST_NORMAL, 0, 1, {0}
},
/* Error cases */
{"null_addr", "0 ENTROPY@", "Should handle null address", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "ENTROPY@", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ENTROPY!", {
/* Basic functionality - ' returns xt (DictEntry*), NOT body address */
{
"set_entropy", ": ENTSET ; 42 ' ENTSET ENTROPY! ' ENTSET ENTROPY@ . CR",
"Should set entropy to 42", TEST_NORMAL, 0, 1, {0}
},
{
"overwrite",
": ENTOV ; 10 ' ENTOV ENTROPY! 20 ' ENTOV ENTROPY! ' ENTOV ENTROPY@ . CR",
"Should overwrite previous value", TEST_NORMAL, 0, 1, {0}
},
{
"zero_entropy", ": ENTZERO ; 0 ' ENTZERO ENTROPY! ' ENTZERO ENTROPY@ . CR",
"Should set entropy to 0", TEST_NORMAL, 0, 1, {0}
},
/* Error cases */
{"null_addr", "42 0 ENTROPY!", "Should handle null address", TEST_ERROR_CASE, 1, 1, {0}},
{"one_arg", "42 ENTROPY!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "ENTROPY!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"WORD-ENTROPY", {
/* Basic functionality - WORD-ENTROPY just prints stats, no stack interaction */
{
"display_all", "1 DUP DUP DUP DROP DROP DROP DROP WORD-ENTROPY",
"Should display all word entropy stats", TEST_NORMAL, 0, 1, {0}
},
{
"after_execution", ": WDENT 1 2 + DROP ; WDENT WDENT WORD-ENTROPY",
"Should show defined word entropy", TEST_NORMAL, 0, 1, {0}
},
/* No stack effect */
{
"stack_preserved", "DEPTH WORD-ENTROPY DEPTH = . CR",
"Should not affect stack", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"RESET-ENTROPY", {
/* Basic functionality */
{
"reset_defined", ": RESETTEST 1 DROP ; RESETTEST RESETTEST RESETTEST RESET-ENTROPY",
"Should reset all entropy counters", TEST_NORMAL, 0, 1, {0}
},
/* Idempotent */
{"double_reset", "RESET-ENTROPY RESET-ENTROPY", "Should handle multiple resets", TEST_NORMAL, 0, 1, {0}},
/* Verify it runs without error */
{
"after_usage", "1 DUP DUP DUP DROP DROP DROP DROP RESET-ENTROPY", "Should reset after word usage",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"TOP-WORDS", {
/* Basic functionality - TOP-WORDS requires ( n -- ) stack parameter */
{
"display_top5", ": TOPTEST 1 DROP ; TOPTEST TOPTEST TOPTEST TOPTEST TOPTEST 5 TOP-WORDS",
"Should display top 5 hot words", TEST_NORMAL, 0, 1, {0}
},
{"display_top10", "10 TOP-WORDS", "Should display top 10 words", TEST_NORMAL, 0, 1, {0}},
{"after_reset", "RESET-ENTROPY 5 TOP-WORDS", "Should handle display after reset", TEST_NORMAL, 0, 1, {0}},
/* Different counts */
{"single_word", "1 TOP-WORDS", "Should display top 1 word", TEST_NORMAL, 0, 1, {0}},
{"large_count", "100 TOP-WORDS", "Should handle large count", TEST_NORMAL, 0, 1, {0}},
/* Error cases */
{"zero_count", "0 TOP-WORDS", "Should handle zero count", TEST_NORMAL, 0, 1, {0}},
{"negative_count", "-5 TOP-WORDS", "Should handle negative count", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "TOP-WORDS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"(-", {
/* Basic functionality */
{"comment_line", "(- This is a comment\n1 2 + . CR", "Should ignore rest of line", TEST_NORMAL, 0, 1, {0}},
{"mid_line", "1 (- comment here\n2 + . CR", "Should work mid-expression", TEST_NORMAL, 0, 1, {0}},
/* Stack preservation */
{"no_stack_effect", "DEPTH (- comment\nDEPTH = . CR", "Should not affect stack", TEST_NORMAL, 0, 1, {0}},
/* Multiple comments */
{"multiple", "1 (- first\n2 (- second\n+ . CR", "Should handle multiple comments", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
/* INIT intentionally not tested here - it's a startup operation that loads
* and executes init.4th. Running it during POST would cause double-initialization. */
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all StarForth words test suites
* @param vm Pointer to the FORTH virtual machine instance
*
* Runs through all test cases for StarForth-specific implementation words,
* including entropy tracking, comments, and initialization.
*/
void run_starforth_words_tests(VM *vm) {
log_message(LOG_INFO, "Running StarForth Words Tests (Module 17: StarForth Extensions)...");
for (int i = 0; starforth_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &starforth_word_suites[i]);
}
print_module_summary("StarForth Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/stress_tests.c
+365
View File
@@ -0,0 +1,365 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
/**
* @file stress_tests.c
* @brief FORTH-79 Standard Comprehensive Stress Testing Module
*
* This module contains extensive stress tests that verify the interpreter's behavior
* under extreme conditions while remaining within FORTH-79 standard compliance.
*
* Test categories (expanded):
* - Deep nesting of control structures (up to 5 levels)
* - Stack exhaustion and boundary tests (near-limit operations)
* - Numeric boundary conditions (cell_t min/max, overflow)
* - Dictionary pressure (many definitions, long names)
* - Word execution chains (deep call stacks)
* - Control flow edge cases (empty loops, large counts, EXIT)
* - Memory allocation patterns (fragmentation, large blocks)
* - Error recovery (ABORT, stack underflow recovery)
* - Large definitions and word chains
*
* IMPORTANT: These tests only use FORTH-79 standard words. Features from
* later standards (ANS Forth 1994, Forth 2012) are NOT tested here:
* - RECURSE (ANS Forth) - not in FORTH-79
* - Self-referential definitions - not supported in FORTH-79
* - Extended VARIABLE usage - only standard semantics tested
*
* For testing extended/non-standard features, see integration_tests.c
*/
#include <stdio.h>
#include "test_common.h"
#include "test_runner.h"
/* Comprehensive stress test suites */
static WordTestSuite stress_suites[] = {
/* ===== 1. STACK DEPTH TESTS ===== */
{
"STACK_DEPTH", {
{"deep_push", ": PUSH-100 0 100 0 DO I LOOP ; PUSH-100 DEPTH . CR", "Push 100 items", TEST_NORMAL, 0, 1, {0}},
{"deep_math", ": MATH-STRESS 1 100 0 DO 1+ LOOP . CR ; MATH-STRESS", "100 additions", TEST_NORMAL, 0, 1, {0}},
{
"dup_stress", ": DUP-STRESS 42 50 0 DO DUP LOOP DEPTH . CR 51 0 DO DROP LOOP ; DUP-STRESS", "50 DUPs",
TEST_NORMAL, 0, 1, {0}
},
{
"deep_push_200",
": PUSH-200 0 200 0 DO I LOOP ; : CLR-200 200 0 DO DROP LOOP ; PUSH-200 DEPTH . CR CLR-200",
"Push 200 items", TEST_NORMAL, 0, 1, {0}
},
{
"mixed_ops", ": MIXED 1 2 3 4 5 6 7 8 9 10 50 0 DO SWAP ROT LOOP 10 0 DO DROP LOOP ; MIXED",
"Mixed stack ops", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* ===== 2. STACK BOUNDARY TESTS ===== */
{
"STACK_BOUNDARY", {
{
"near_limit_900",
": PUSH-900 0 900 0 DO I LOOP ; : CLR-900 900 0 DO DROP LOOP ; PUSH-900 DEPTH . CR CLR-900 FORGET CLR-900",
"Push 900 items (near 1024 limit)", TEST_EDGE_CASE, 0, 1, {0}
},
{"underflow_detect", "DROP", "Stack underflow detection", TEST_ERROR_CASE, 1, 1, {0}},
{"dup_underflow", "DUP", "DUP underflow detection", TEST_ERROR_CASE, 1, 1, {0}},
{"swap_underflow", "1 SWAP", "SWAP underflow detection", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
/* ===== 3. RETURN STACK STRESS ===== */
{
"RETURN_STACK", {
{"basic_to_r", "1 2 3 >R >R >R R> R> R> + + . CR", "Basic >R/R> test", TEST_NORMAL, 0, 1, {0}},
{"r_fetch", "42 >R R@ . CR R> DROP", "R@ test", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 4. DEEP NESTING TESTS ===== */
{
"DEEP_NESTING", {
{
"nested_if_5",
": NEST5 DUP 0> IF DUP 10 > IF DUP 20 > IF DUP 30 > IF DUP 40 > IF 5 ELSE 4 THEN ELSE 3 THEN ELSE 2 THEN ELSE 1 THEN ELSE 0 THEN . CR ; 45 NEST5",
"5-level IF nesting", TEST_NORMAL, 0, 1, {0}
},
{
"nested_loops_4", ": NEST-4 0 2 0 DO 2 0 DO 2 0 DO 2 0 DO 1+ LOOP LOOP LOOP LOOP . CR ; NEST-4",
"4-level DO loop nesting", TEST_NORMAL, 0, 1, {0}
},
{
"mixed_if_do", ": MIX-NEST 0 10 0> IF 5 0 DO 1+ LOOP ELSE 3 0 DO 2 + LOOP THEN . CR ; MIX-NEST",
"IF with DO inside", TEST_NORMAL, 0, 1, {0}
},
{
"begin_simple", ": BEGIN-TEST 5 BEGIN 1- DUP 0= UNTIL DROP ; BEGIN-TEST",
"Simple BEGIN/UNTIL loop", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
/* ===== 5. CONTROL FLOW EDGE CASES ===== */
{
"CONTROL_EDGE", {
{"empty_loop", ": EMPTY-LOOP 0 0 DO LOOP ; EMPTY-LOOP", "Empty loop body", TEST_NORMAL, 0, 1, {0}},
{"single_iter", ": SINGLE 1 0 DO 42 . LOOP CR ; SINGLE", "Single iteration", TEST_NORMAL, 0, 1, {0}},
{"large_count", ": BIG-LOOP 0 10000 0 DO 1+ LOOP . CR ; BIG-LOOP", "10000 iterations", TEST_NORMAL, 0, 1, {0}},
{
"nested_exit", ": NEST-EXIT 10 0 DO I 5 = IF EXIT THEN I . LOOP CR ; NEST-EXIT", "EXIT in nested loop",
TEST_NORMAL, 0, 1, {0}
},
{
"begin_while", ": B-W-R 10 BEGIN DUP 0> WHILE DUP . 1- REPEAT DROP CR ; B-W-R", "BEGIN WHILE REPEAT",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* ===== 6. NUMERIC BOUNDARIES ===== */
{
"NUMERIC_BOUNDARY", {
{"max_int", ": MAX-TEST 2147483647 DUP . 1+ . CR ; MAX-TEST", "Max int boundary", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", ": MIN-TEST -2147483648 DUP . 1- . CR ; MIN-TEST", "Min int boundary", TEST_EDGE_CASE, 0, 1, {0}},
{"large_mult", ": BIG-MULT 10000 10000 * . CR ; BIG-MULT", "Large multiplication", TEST_NORMAL, 0, 1, {0}},
{
"div_edge", ": DIV-TEST 100 1 / 100 2 / 100 3 / . . . CR ; DIV-TEST", "Division edge cases",
TEST_NORMAL, 0, 1, {0}
},
{"mod_edge", ": MOD-TEST 100 7 MOD 100 3 MOD . . CR ; MOD-TEST", "Modulo operations", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* ===== 7. WORD EXECUTION CHAINS ===== */
{
"EXEC_CHAINS", {
{
"chain_10",
": C1 1 ; : C2 C1 1+ ; : C3 C2 1+ ; : C4 C3 1+ ; : C5 C4 1+ ; : C6 C5 1+ ; : C7 C6 1+ ; : C8 C7 1+ ; : C9 C8 1+ ; : C10 C9 1+ ; C10 . CR",
"10-word call chain", TEST_NORMAL, 0, 1, {0}
},
{
"chain_20",
": D1 1 ; : D2 D1 1+ ; : D3 D2 1+ ; : D4 D3 1+ ; : D5 D4 1+ ; : D6 D5 1+ ; : D7 D6 1+ ; : D8 D7 1+ ; : D9 D8 1+ ; : D10 D9 1+ ; : D11 D10 1+ ; : D12 D11 1+ ; : D13 D12 1+ ; : D14 D13 1+ ; : D15 D14 1+ ; : D16 D15 1+ ; : D17 D16 1+ ; : D18 D17 1+ ; : D19 D18 1+ ; : D20 D19 1+ ; D20 . CR",
"20-word call chain", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 8. LARGE DEFINITIONS ===== */
{
"LARGE_DEF", {
{
"long_sequence_50",
": LONG50 1 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ 1+ . CR ; LONG50",
"50+ operations", TEST_NORMAL, 0, 1, {0}
},
{
"many_literals",
": LITS 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + + + + + + + + + + + + + + + + + + + . CR ; LITS",
"20 literals", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 9. DICTIONARY PRESSURE ===== */
{
"DICT_PRESSURE", {
{
"many_defs",
": T1 1 ; : T2 2 ; : T3 3 ; : T4 4 ; : T5 5 ; : T6 6 ; : T7 7 ; : T8 8 ; : T9 9 ; : T10 10 ; : T11 11 ; : T12 12 ; : T13 13 ; : T14 14 ; : T15 15 ; : T16 16 ; : T17 17 ; : T18 18 ; : T19 19 ; : T20 20 ; T20 . CR",
"20 word definitions", TEST_NORMAL, 0, 1, {0}
},
{
"long_name", ": VERY-LONG-WORD-NAME-TEST-MAX 42 . CR ; VERY-LONG-WORD-NAME-TEST-MAX",
"Long word name (31 chars)", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 10. MEMORY ALLOCATION STRESS ===== */
{
"MEMORY_STRESS", {
{
"allot_100", ": ALLOT-100 HERE 100 ALLOT HERE SWAP - . CR ; ALLOT-100", "ALLOT 100 bytes", TEST_NORMAL, 0, 1, {0}
},
{"allot_1000", ": ALLOT-1K HERE 1000 ALLOT HERE SWAP - . CR ; ALLOT-1K", "ALLOT 1KB", TEST_NORMAL, 0, 1, {0}},
{"allot_8k", ": ALLOT-8K HERE 8192 ALLOT HERE SWAP - . CR ; ALLOT-8K", "ALLOT 8KB", TEST_NORMAL, 0, 1, {0}},
{
"multiple_allots", ": MULTI-ALLOT HERE 10 ALLOT 20 ALLOT 30 ALLOT HERE SWAP - . CR ; MULTI-ALLOT",
"Multiple ALLOTs", TEST_NORMAL, 0, 1, {0}
},
{
"allot_pattern", ": PATTERN 5 0 DO HERE 100 ALLOT DROP LOOP ; PATTERN", "Repeated allot pattern",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* ===== 11. ERROR RECOVERY ===== */
{
"ERROR_RECOVERY", {
{"abort_recovery", ": AB-TEST 1 2 3 ABORT ; AB-TEST DEPTH . CR", "ABORT clears stacks", TEST_NORMAL, 0, 1, {0}},
{"continue_after_abort", "ABORT 42 . CR", "Can continue after ABORT", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 12. DOUBLE NUMBER STRESS ===== */
{
"DOUBLE_STRESS", {
{"large_double_add", "1000000 0 2000000 0 D+ . . CR", "Large double addition", TEST_NORMAL, 0, 1, {0}},
{"double_chain", "100 200 2DUP D+ . . CR", "Double operation chain", TEST_NORMAL, 0, 1, {0}},
{"double_negate", "100 200 DNEGATE DNEGATE . . CR", "Double negate twice", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* ===== 13. MIXED COMPLEXITY ===== */
{
"MIXED_COMPLEX", {
{
"nested_if_do",
": COMPLEX 10 0 DO I DUP 5 > IF 2 * ELSE 3 + THEN . LOOP CR ; COMPLEX",
"Mixed IF/DO", TEST_NORMAL, 0, 1, {0}
},
{
"nested_begin_do",
": NB-DO 5 BEGIN DUP 0> WHILE DUP 3 0 DO I . LOOP CR 1- REPEAT DROP ; NB-DO",
"Nested BEGIN/DO", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* ===== 14. STRING/BUFFER EDGE CASES ===== */
{
"STRING_EDGE", {
{"empty_def", ": EMPTY ; EMPTY", "Empty definition", TEST_NORMAL, 0, 1, {0}},
{"single_word", ": SINGLE DUP ; 42 SINGLE . . CR", "Single word def", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
};
/**
* @brief Execute comprehensive stress test suites
*
* Runs an extensive set of stress tests to verify the VM's behavior
* under extreme conditions. Tests include:
* - Stack operations and boundaries
* - Deep nesting and control flow
* - Numeric boundaries and overflow
* - Dictionary pressure
* - Memory allocation patterns
* - Error recovery
* - Mixed complexity scenarios
*
* All tests are FORTH-79 compliant.
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_stress_tests(VM *vm) {
if (!vm) return;
// Reset global stats for stress tests
extern TestStats global_test_stats;
global_test_stats.total_tests = 0;
global_test_stats.total_pass = 0;
global_test_stats.total_fail = 0;
global_test_stats.total_skip = 0;
global_test_stats.total_error = 0;
log_message(LOG_INFO, "==============================================");
log_message(LOG_INFO, " StarForth Comprehensive Stress Test Suite");
log_message(LOG_INFO, " FORTH-79 Standard Compliance");
log_message(LOG_INFO, "==============================================\n");
for (size_t i = 0; i < sizeof(stress_suites) / sizeof(WordTestSuite); i++) {
log_message(LOG_TEST, "▶ Testing category: %s", stress_suites[i].word_name);
run_test_suite(vm, &stress_suites[i]);
}
log_message(LOG_INFO, "==============================================");
log_message(LOG_INFO, " COMPREHENSIVE STRESS TEST RESULTS");
log_message(LOG_INFO, "==============================================");
log_message(LOG_INFO, " Total tests: %d", global_test_stats.total_tests);
log_message(LOG_INFO, " Passed: %d", global_test_stats.total_pass);
log_message(LOG_INFO, " Failed: %d", global_test_stats.total_fail);
log_message(LOG_INFO, " Skipped: %d", global_test_stats.total_skip);
log_message(LOG_INFO, " Errors: %d", global_test_stats.total_error);
if (global_test_stats.total_fail == 0 && global_test_stats.total_error == 0) {
log_message(LOG_INFO, "\n ✓ ALL STRESS TESTS PASSED!");
log_message(LOG_INFO, " StarForth demonstrates excellent stability");
log_message(LOG_INFO, " under extreme FORTH-79 workload conditions.");
} else {
log_message(LOG_INFO, "\n ✗ SOME TESTS FAILED");
log_message(LOG_INFO, " Review output above for details");
}
log_message(LOG_INFO, "==============================================\n");
}
v3/src/test_runner/modules/string_words_test.c
+219
View File
@@ -0,0 +1,219 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* String Words Test Suites - Module 11 */
static WordTestSuite string_word_suites[] = {
{
"COUNT", {
{"basic", "HERE S\" Test\" DROP COUNT . . CR", "Should show length and addr+1", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE 0 OVER C! COUNT . . CR", "Should handle empty string", TEST_NORMAL, 0, 1, {0}},
{"max_length", "HERE 255 OVER C! COUNT . . CR", "Should handle max length", TEST_NORMAL, 0, 1, {0}},
{"string_bounds", "HERE COUNT SWAP 1- = . CR", "Should increment address", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "COUNT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"-TRAILING", {
{"basic", "HERE S\" Test \" -TRAILING TYPE CR", "Should trim spaces", TEST_NORMAL, 0, 1, {0}},
{"all_spaces", "HERE S\" \" -TRAILING TYPE CR", "Should handle all spaces", TEST_NORMAL, 0, 1, {0}},
{"no_spaces", "HERE S\" Test\" -TRAILING TYPE CR", "Should handle no spaces", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE 0 -TRAILING TYPE CR", "Should handle empty string", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"CMOVE", {
{"basic", "HERE S\" Test\" DUP >R HERE 10 + SWAP CMOVE CR", "Should copy string", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE HERE 10 + 0 CMOVE", "Should handle zero count", TEST_NORMAL, 0, 1, {0}},
{"overlap", "HERE DUP 1+ 5 CMOVE", "Should handle overlap", TEST_NORMAL, 0, 1, {0}},
{"bounds", "HERE PAD 1000 CMOVE", "Should check bounds", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"CMOVE>", {
{"basic", "HERE S\" Test\" DUP >R HERE 10 + SWAP CMOVE> CR", "Should copy backward", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE HERE 10 + 0 CMOVE>", "Should handle zero count", TEST_NORMAL, 0, 1, {0}},
{"overlap", "HERE DUP 1+ 5 CMOVE>", "Should handle overlap", TEST_NORMAL, 0, 1, {0}},
{"bounds", "HERE PAD 1000 CMOVE>", "Should check bounds", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"COMPARE", {
{"equal", "HERE S\" Test\" HERE S\" Test\" COMPARE . CR", "Should return 0", TEST_NORMAL, 0, 1, {0}},
{"less", "HERE S\" Test1\" HERE S\" Test2\" COMPARE . CR", "Should return -1", TEST_NORMAL, 0, 1, {0}},
{"greater", "HERE S\" Test2\" HERE S\" Test1\" COMPARE . CR", "Should return 1", TEST_NORMAL, 0, 1, {0}},
{
"different_lengths", "HERE S\" Test\" HERE S\" Testing\" COMPARE . CR", "Should handle lengths",
TEST_NORMAL, 0, 1, {0}
},
{"empty", "HERE 0 HERE 0 COMPARE . CR", "Should handle empty", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"SEARCH", {
{"found", "HERE S\" Testing\" HERE S\" Test\" SEARCH . . . CR", "Should find substring", TEST_NORMAL, 0, 1, {0}},
{
"not_found", "HERE S\" Testing\" HERE S\" Xyz\" SEARCH . . . CR", "Should return false", TEST_NORMAL, 0,
1, {0}
},
{
"empty_pattern", "HERE S\" Test\" HERE 0 SEARCH . . . CR", "Should handle empty pattern", TEST_NORMAL, 0, 1, {0}
},
{"empty_string", "HERE 0 HERE S\" Test\" SEARCH . . . CR", "Should handle empty string", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SCAN", {
{"basic", "HERE S\" Test,Data\" BL SCAN TYPE CR", "Should find space", TEST_NORMAL, 0, 1, {0}},
{"not_found", "HERE S\" TestData\" BL SCAN TYPE CR", "Should scan to end", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE 0 BL SCAN TYPE CR", "Should handle empty", TEST_NORMAL, 0, 1, {0}},
{"all_delims", "HERE S\" \" BL SCAN TYPE CR", "Should handle all delims", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SKIP", {
{"basic", "HERE S\" Test\" BL SKIP TYPE CR", "Should skip spaces", TEST_NORMAL, 0, 1, {0}},
{"no_delims", "HERE S\" Test\" BL SKIP TYPE CR", "Should not skip", TEST_NORMAL, 0, 1, {0}},
{"empty", "HERE 0 BL SKIP TYPE CR", "Should handle empty", TEST_NORMAL, 0, 1, {0}},
{"all_delims", "HERE S\" \" BL SKIP TYPE CR", "Should skip all", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"BLANK", {
{"basic", "HERE 5 BLANK HERE 5 TYPE CR", "Should fill with spaces", TEST_NORMAL, 0, 1, {0}},
{"zero", "HERE 0 BLANK HERE 0 TYPE CR", "Should handle zero count", TEST_NORMAL, 0, 1, {0}},
/* TODO: Bounds checking - memory subsystem doesn't yet enforce upper bounds */
/* {"bounds", "HERE 2000000 BLANK", "Should check bounds", TEST_ERROR_CASE, 1, 1}, */
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"S\"", {
{"interpret_len", "S\" hello\" . CR", "Should print: 5 (length)", TEST_NORMAL, 0, 1, {0}},
{"interpret_type", "S\" hello\" TYPE CR", "Should print: hello", TEST_NORMAL, 0, 1, {0}},
{"empty", "S\" \" . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"compile_type", ": TSQ S\" world\" TYPE CR ; TSQ", "Should print: world", TEST_NORMAL, 0, 1, {0}},
{"compile_len", ": TSQ2 S\" forth\" SWAP DROP . CR ; TSQ2", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"compile_twice", ": TSQ3 S\" ab\" TYPE S\" cd\" TYPE CR ; TSQ3", "Should print: abcd", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"BL", {
{"value", "BL . CR", "Should print: 32", TEST_NORMAL, 0, 1, {0}},
{"as_char", "BL EMIT CR", "Should emit a space", TEST_NORMAL, 0, 1, {0}},
{"in_scan", "HERE S\" a b\" BL SCAN SWAP DROP . CR", "Should find space at offset 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"SOURCE", {
{"returns_pair", "SOURCE SWAP DROP 0< NOT . CR", "Should return non-negative length", TEST_NORMAL, 0, 1, {0}},
{"has_addr", "SOURCE DROP 0<> . CR", "Should return non-null address", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
">IN", {
{"initial", ">IN @ . CR", "Should return input offset", TEST_NORMAL, 0, 1, {0}},
{"advances", ": TWIN >IN @ >IN @ - . CR ; TWIN", "Should print: 0 (no advance inside compiled word)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all string manipulation word tests
*
* @details Runs test suites for FORTH string operations including COUNT, -TRAILING,
* CMOVE, CMOVE>, COMPARE, SEARCH, SCAN, SKIP, and BLANK
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_string_words_tests(VM *vm) {
log_message(LOG_INFO, "Running String Words Tests (Module 11)...");
for (int i = 0; string_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &string_word_suites[i]);
}
print_module_summary("String Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/system_words_test.c
+133
View File
@@ -0,0 +1,133 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suite definitions for system control words
* @details Contains test cases for each system word including normal operations
* and error conditions
*/
static WordTestSuite system_word_suites[] = {
{
"QUIT", {
{"basic", "QUIT", "Should reset stacks and state", TEST_NORMAL, 0, 0, {0}}, // Interactive
{"in_definition", ": BAD-WORD QUIT ;", "Should prevent compilation", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"ABORT", {
{"basic", "ABORT", "Should clear stacks and return to QUIT", TEST_NORMAL, 0, 1, {0}},
{"with_data", "1 2 3 ABORT DEPTH . CR", "Should clear stack", TEST_NORMAL, 0, 1, {0}},
{
"in_definition_runtime", ": BAD-WORD ABORT ; 123 BAD-WORD DEPTH . CR",
"ABORT may appear in a definition; when executed it clears both stacks", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"ABORT\"", {
{
"condition_true", "-1 ABORT\" Error\"", "Should abort with message (no error; stacks cleared to QUIT)",
TEST_NORMAL, 0, 1, {0}
},
{"condition_false", "0 ABORT\" Error\"", "Should not abort", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "ABORT\"", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"BYE", {
{"basic", "BYE", "Should exit cleanly", TEST_NORMAL, 0, 0, {0}}, // Can't really test
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"COLD", {
{"basic", "COLD", "Should reset system", TEST_NORMAL, 0, 0, {0}}, // Dangerous to test
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"WARM", {
{"basic", "WARM", "Should soft reset", TEST_NORMAL, 0, 0, {0}}, // Dangerous to test
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all system word tests
* @details Runs test suites for FORTH system control operations including QUIT,
* ABORT, ABORT", BYE, COLD, and WARM. Some tests are marked as unimplemented
* due to their system-level effects
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_system_words_tests(VM *vm) {
log_message(LOG_INFO, "Running System Words Tests (Module 18)...");
log_message(LOG_WARN, "Some system tests marked as unimplemented due to system-level effects");
for (int i = 0; system_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &system_word_suites[i]);
}
print_module_summary("System Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/vocabulary_words_test.c
+163
View File
@@ -0,0 +1,163 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/** @brief Test suites for vocabulary-related FORTH words (Module 15)
* @details Contains test cases for each vocabulary word, including normal operations
* and error cases. Each suite tests specific functionality of the vocabulary system.
*/
static WordTestSuite vocabulary_word_suites[] = {
{
"VOCABULARY", {
/* Basic functionality */
{"basic", "VOCABULARY TEST-VOC1 TEST-VOC1 DEFINITIONS", "Should create vocabulary", TEST_NORMAL, 0, 1, {0}},
{
"create_and_switch", "VOCABULARY MYVOC MYVOC DEFINITIONS CONTEXT @ . CR", "Should create and switch",
TEST_NORMAL, 0, 1, {0}
},
/* Word isolation */
{
"word_isolation", "VOCABULARY ISOLATED ISOLATED DEFINITIONS : ISOWORD 99 ; FORTH DEFINITIONS",
"Should create word in isolated vocab", TEST_NORMAL, 0, 1, {0}
},
{
"cross_vocab_access", "VOCABULARY V1 V1 DEFINITIONS : V1WORD 11 ; FORTH V1WORD . CR",
"Should access word across vocabs", TEST_NORMAL, 0, 1, {0}
},
/* Multiple vocabularies */
{
"multiple_vocabs", "VOCABULARY VA VOCABULARY VB VOCABULARY VC VA DEFINITIONS",
"Should create multiple vocabs", TEST_NORMAL, 0, 1, {0}
},
/* Error cases */
{
"duplicate", "VOCABULARY TESTVOC VOCABULARY TESTVOC", "Should handle duplicate", TEST_ERROR_CASE, 1,
1, {0}
},
{"empty_name", "VOCABULARY", "Should handle empty name", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"FORTH", {
{"basic", "FORTH DEFINITIONS", "Should select FORTH vocab", TEST_NORMAL, 0, 1, {0}},
{"persistence", "FORTH : TEST1 42 ; TEST1 . CR", "Should find word in FORTH", TEST_NORMAL, 0, 1, {0}},
{"from_other", "VOCABULARY OTHER-VOC OTHER-VOC FORTH", "Should return to FORTH", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"DEFINITIONS", {
{"basic", "FORTH DEFINITIONS", "Should set current vocabulary", TEST_NORMAL, 0, 1, {0}},
{"new_vocab", "VOCABULARY TEST-VOC6 TEST-VOC6 DEFINITIONS", "Should set new current", TEST_NORMAL, 0, 1, {0}},
{
"word_creation", "VOCABULARY TEST-VOC7 TEST-VOC7 DEFINITIONS : TEST2 43 ;",
"Should create in correct vocab", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CONTEXT", {
{"basic", "CONTEXT @ . CR", "Should show current context", TEST_NORMAL, 0, 1, {0}},
{"modify", "CONTEXT @ 1+ CONTEXT !", "Should allow modification (impl-defined effect)", TEST_NORMAL, 0, 1, {0}},
{"initial", "FORTH CONTEXT @ . CR", "Should show FORTH vocab", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CURRENT", {
{"basic", "CURRENT @ . CR", "Should show current vocab", TEST_NORMAL, 0, 1, {0}},
{
"after_def", "VOCABULARY TEST-VOC8 TEST-VOC8 DEFINITIONS CURRENT @ . CR", "Should show new vocab",
TEST_NORMAL, 0, 1, {0}
},
{"protect", "CURRENT @ 1+ CURRENT !", "Should allow modification (impl-defined effect)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"ORDER", {
{"basic", "ORDER", "Should list search order", TEST_NORMAL, 0, 1, {0}},
{
"multiple", "VOCABULARY TEST-VOC9 TEST-VOC9 DEFINITIONS ORDER", "Should show all vocabs", TEST_NORMAL, 0, 1, {0}
},
{"after_forth", "TEST-VOC9 FORTH ORDER", "Should show FORTH only", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/** @brief Executes all vocabulary word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all vocabulary-related test suites, executing each test case
* and logging the results_run_01_2025_12_08. Tests vocabulary creation, selection, and manipulation.
*/
void run_vocabulary_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Vocabulary Words Tests (Module 15)...");
for (int i = 0; vocabulary_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &vocabulary_word_suites[i]);
}
print_module_summary("Vocabulary Words", 0, 0, 0, 0);
}
v3/src/test_runner/test_common.c
+510
View File
@@ -0,0 +1,510 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "../../include/vm.h"
#include "../../include/vm_debug.h"
#include "include/test_common.h"
#include "include/test_contracts.h"
#include "../../include/log.h"
#include "test_runner.h"
#ifdef __STARKERNEL__
#include "starkernel/hal/hal.h"
#define test_fatal_exit() sk_hal_panic("test failure - fail fast")
#else
#include <stdio.h>
#include <stdlib.h>
#define test_fatal_exit() exit(1)
#endif
/**
* @brief Global flag to control test execution behavior
* @details When set to non-zero, causes test runner to exit immediately on first failure
*/
int fail_fast = 0;
/* ---------- debug helpers (dump on fatal and exit) ---------- */
/**
* @brief Dumps VM state and terminates execution
* @param vm Pointer to VM instance
* @param reason String describing the failure reason
* @param file Source file where failure occurred
* @param line Line number where failure occurred
*/
static void dump_and_die(VM* vm, const char* reason, const char* file, int line)
{
log_message(LOG_ERROR, "[TEST-RUNNER] abort @ %s:%d (%s)",
file, line, reason ? reason : "no-reason");
vm_debug_dump_state(vm, reason ? reason : "test-failure");
test_fatal_exit();
}
/* Convenience macro so call sites get file:line automatically */
#define DIE(vm, why) dump_and_die((vm), (why), __FILE__, __LINE__)
/* Single gate used by fail-fast paths */
/**
* @brief Handles test failure and exits
* @param vm Pointer to VM instance
* @param module Name of the test module
* @param case_name Name of the test case
* @param input Test input that caused the failure
* @param reason Description of failure reason
*/
static void fail_and_exit(VM* vm,
const char* module,
const char* case_name,
const char* input,
const char* reason)
{
if (module && *module && case_name && *case_name)
{
log_message(LOG_ERROR, "[TEST-RUNNER] FAIL in %s.%s", module, case_name);
}
else if (module && *module)
{
log_message(LOG_ERROR, "[TEST-RUNNER] FAIL in %s", module);
}
if (input && *input)
{
log_message(LOG_ERROR, "[TEST-RUNNER] Input: %s", input);
}
if (reason && *reason)
{
log_message(LOG_ERROR, "[TEST-RUNNER] Reason: %s", reason);
}
/* Dump VM state at point-of-failure and exit */
DIE(vm, reason ? reason : "assertion failed");
}
/* ---------- VM state save/restore ---------- */
/**
* @brief Saves current VM state
* @param vm Pointer to VM instance
* @param dsp Pointer to store data stack pointer
* @param rsp Pointer to store return stack pointer
* @param error Pointer to store error state
* @param mode Pointer to store VM mode
*/
void save_vm_state(VM* vm, int* dsp, int* rsp, int* error, vm_mode_t* mode)
{
*dsp = vm->dsp;
*rsp = vm->rsp;
*error = vm->error;
*mode = vm->mode;
}
/**
* @brief Restores previously saved VM state
* @param vm Pointer to VM instance
* @param dsp Data stack pointer to restore
* @param rsp Return stack pointer to restore
* @param error Error state to restore
* @param mode VM mode to restore
*/
void restore_vm_state(VM* vm, int dsp, int rsp, int error, vm_mode_t mode)
{
/* Restore to the caller-supplied saved state -- every real caller
* (acl_words_test.c, this file's own save/restore pairs) captures
* dsp/rsp/error/mode before running a test specifically so it can be
* put back here. This previously ignored all four parameters and
* hard-reset to a fixed baseline instead, silently not restoring
* anything callers actually saved. */
vm->dsp = dsp;
vm->rsp = rsp;
vm->error = error;
vm->mode = mode;
/* Clear control flow flags to prevent stale state between tests */
vm->exit_colon = 0;
vm->abort_requested = 0;
/* Clear compilation state in case test left system in compile mode */
vm->compiling_word = NULL;
vm->current_executing_entry = NULL;
}
/* ---------- Assertions ---------- */
/**
* @brief Verifies VM stack depth matches expected value
* @param vm Pointer to VM instance
* @param expected_depth Expected stack depth
* @return 1 if assertion passes, 0 if it fails
*/
int assert_stack_depth(VM* vm, int expected_depth)
{
if (vm->dsp == expected_depth)
{
return 1;
}
log_message(LOG_ERROR, "Stack depth mismatch: expected %d, got %d", expected_depth, vm->dsp);
return 0;
}
/**
* @brief Verifies top value on VM stack matches expected value
* @param vm Pointer to VM instance
* @param expected_value Expected value on top of stack
* @return 1 if assertion passes, 0 if it fails
*/
int assert_stack_top(VM* vm, int expected_value)
{
if (vm->dsp < 1)
{
log_message(LOG_ERROR, "Stack underflow when checking top value");
return 0;
}
if (vm->data_stack[vm->dsp - 1] == expected_value)
{
return 1;
}
log_message(LOG_ERROR, "Stack top mismatch: expected %d, got %d",
expected_value, vm->data_stack[vm->dsp - 1]);
return 0;
}
/**
* @brief Verifies VM error state matches expectation
* @param vm Pointer to VM instance
* @param should_have_error Expected error state (1 for error, 0 for no error)
* @return 1 if assertion passes, 0 if it fails
*/
int assert_vm_error(VM* vm, int should_have_error)
{
int has_error = (vm->error != 0);
if (has_error == should_have_error)
{
return 1;
}
if (should_have_error)
{
log_message(LOG_ERROR, "Expected VM error but none occurred");
}
else
{
log_message(LOG_ERROR, "Unexpected VM error: %d", vm->error);
}
return 0;
}
/* ---------- Test execution ---------- */
/* Run a single test case */
/**
* @brief Executes a single test case
* @param vm Pointer to VM instance
* @param word_name Name of the word being tested
* @param test Pointer to test case definition
* @return Test result (PASS, FAIL, SKIP, or ERROR)
*/
TestResult run_single_test(VM* vm, const char* word_name, const TestCase* test)
{
if (!test->implemented)
{
log_test_result(word_name, TEST_SKIP);
return TEST_SKIP;
}
/* Save VM state */
int saved_dsp, saved_rsp, saved_error;
vm_mode_t saved_mode;
save_vm_state(vm, &saved_dsp, &saved_rsp, &saved_error, &saved_mode);
/* Clear error state */
vm->error = 0;
log_message(LOG_TEST, " Running %s.%s: %s", word_name, test->name, test->input);
/* Execute the test */
vm_interpret(vm, test->input);
/* Check results */
TestResult result;
if (test->should_error)
{
if (vm->error != 0)
{
result = TEST_PASS;
log_message(LOG_TEST, " Expected error occurred");
}
else
{
result = TEST_FAIL;
log_message(LOG_ERROR, " Expected error but none occurred");
}
}
else
{
if (vm->error != 0)
{
result = TEST_FAIL;
log_message(LOG_ERROR, " Unexpected VM error: %d", vm->error);
}
else
{
result = TEST_PASS;
log_message(LOG_TEST, " Test passed");
}
}
log_test_result(word_name, result);
if (result == TEST_PASS)
{
log_message(LOG_TEST, " Expected: %s", test->expected);
}
/* Restore VM nightly */
restore_vm_state(vm, saved_dsp, saved_rsp, saved_error, saved_mode);
if (result == TEST_FAIL)
{
log_message(LOG_ERROR, "Test failed: %s.%s", word_name, test->name);
log_message(LOG_ERROR, "Input: %s", test->input);
log_message(LOG_ERROR, "Expected: %s", test->expected);
if (fail_fast != 0)
{
/* Fail fast: dump and exit with real names from this scope */
fail_and_exit(vm, word_name, test->name, test->input, "assertion failed");
}
}
return result;
}
/* Run a complete test suite for one word */
/**
* @brief Executes a complete test suite for a Forth word
* @param vm Pointer to VM instance
* @param suite Pointer to test suite definition
*/
void run_test_suite(VM* vm, const WordTestSuite* suite)
{
log_message(LOG_TEST, "Testing word: %s", suite->word_name);
log_message(LOG_TEST, "------------------------");
/* Save dictionary state before test suite */
DictEntry* saved_latest;
size_t saved_here;
save_dict_state(vm, &saved_latest, &saved_here);
int suite_pass = 0;
int suite_fail = 0;
int suite_skip = 0;
int suite_error = 0;
for (int j = 0; j < suite->test_count && suite->tests[j].name != NULL; j++)
{
const TestCase* test = &suite->tests[j];
if (!test->implemented)
{
suite_skip++;
continue;
}
TestResult result = run_single_test(vm, suite->word_name, test);
switch (result)
{
case TEST_PASS: suite_pass++;
break;
case TEST_FAIL: suite_fail++;
break;
case TEST_SKIP: suite_skip++;
break;
case TEST_ERROR: suite_error++;
break;
}
}
/* Restore dictionary state after test suite to remove test-created words */
restore_dict_state(vm, saved_latest, saved_here);
test_stats_accumulate(suite_pass + suite_fail + suite_skip + suite_error,
suite_pass, suite_fail, suite_skip, suite_error);
log_message(LOG_TEST, " %s: %d passed, %d failed, %d stubs, %d errors",
suite->word_name, suite_pass, suite_fail, suite_skip, suite_error);
}
/* ============================================================================
* run_test_suite_m — contract-aware suite runner
* ============================================================================ */
/**
* @brief Resolves the effective contract for a test case.
*
* First non-NONE source wins: per-test > per-suite > module.
*/
static WordContract resolve_contract(WordContract test_c,
WordContract suite_c,
WordContract module_c)
{
if (test_c.flags) return test_c;
if (suite_c.flags) return suite_c;
return module_c;
}
void run_test_suite_m(VM *vm, const WordTestSuite *suite, WordContract module_contract)
{
log_message(LOG_TEST, "Testing word: %s", suite->word_name);
log_message(LOG_TEST, "------------------------");
DictEntry* saved_latest;
size_t saved_here;
save_dict_state(vm, &saved_latest, &saved_here);
int suite_pass = 0;
int suite_fail = 0;
int suite_skip = 0;
int suite_error = 0;
for (int j = 0; j < suite->test_count && suite->tests[j].name != NULL; j++)
{
const TestCase* test = &suite->tests[j];
if (!test->implemented)
{
suite_skip++;
continue;
}
TestResult result = run_single_test(vm, suite->word_name, test);
switch (result)
{
case TEST_PASS:
suite_pass++;
/* A4' contract check for passing non-error tests */
if (result == TEST_PASS && test->type != TEST_ERROR_CASE)
{
WordContract eff = resolve_contract(test->contract,
suite->suite_contract,
module_contract);
if (eff.flags & CONTRACT_PHYSICS_TRANSPARENT)
{
int ok = check_physics_transparent(vm, suite->word_name,
test->input,
test->should_error,
test->implemented,
eff.fuzz_rounds);
if (!ok)
{
/* Demote to fail: contract violation is a test failure */
suite_pass--;
suite_fail++;
}
}
}
break;
case TEST_FAIL: suite_fail++; break;
case TEST_SKIP: suite_skip++; break;
case TEST_ERROR: suite_error++; break;
}
}
restore_dict_state(vm, saved_latest, saved_here);
test_stats_accumulate(suite_pass + suite_fail + suite_skip + suite_error,
suite_pass, suite_fail, suite_skip, suite_error);
log_message(LOG_TEST, " %s: %d passed, %d failed, %d stubs, %d errors",
suite->word_name, suite_pass, suite_fail, suite_skip, suite_error);
}
/* Print module summary */
/**
* @brief Prints test module execution summary
* @param module_name Name of the test module
* @param pass Number of passed tests
* @param fail Number of failed tests
* @param skip Number of skipped tests
* @param error Number of tests with errors
*/
void print_module_summary(const char* module_name, int pass, int fail, int skip, int error)
{
log_message(LOG_TEST, "=== %s Summary: %d passed, %d failed, %d skipped, %d errors ===",
module_name, pass, fail, skip, error);
}
/* ---------- Dictionary State Management ---------- */
/**
* @brief Saves current dictionary state before test execution
* @param vm Pointer to VM instance
* @param latest Pointer to store latest dictionary entry
* @param here Pointer to store HERE pointer
* @details Captures dictionary state so tests can be cleaned up after execution
*/
void save_dict_state(VM* vm, DictEntry** latest, size_t* here)
{
*latest = vm->latest;
*here = vm->here;
}
/**
* @brief Restores dictionary state after test execution
* @param vm Pointer to VM instance
* @param latest Latest dictionary entry to restore
* @param here HERE pointer to restore
* @details Removes all words added during test by restoring dictionary pointers.
* This prevents test pollution of the dictionary and ensures each test
* starts with a clean slate.
*/
void restore_dict_state(VM* vm, DictEntry* latest, size_t here)
{
/* Restore dictionary pointers to state before test */
vm->latest = latest;
vm->here = here;
/* NOTE: We don't free memory here because the dictionary uses a contiguous
* memory region. The memory is still allocated but unreachable. This is
* safe because tests run in a controlled environment and memory is reclaimed
* when the VM terminates. For long-running test suites, consider periodically
* reinitializing the VM. */
}
v3/src/test_runner/test_contracts.c
+356
View File
@@ -0,0 +1,356 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
Licensed under the Starship License 1.0 (SL-1.0)
*/
/*
* test_contracts.c — Runtime witnesses for Isabelle/HOL axioms A1 and A4'.
*
* All contract checks are compiled away when CONTRACTS_ENABLED != 1 so that
* normal `make test` builds carry zero overhead.
*/
#include "test_contracts.h"
#include "log.h" /* log_message, LOG_ERROR, LOG_TEST */
#include "vm.h" /* VM, vm_interpret, vm_tick, ROLLING_WINDOW_SIZE */
#include <string.h> /* memcpy, memset, memcmp */
/* Global violation counter (defined here; declared extern in test_contracts.h) */
int global_contract_violations = 0;
/*
* Accessor functions — same-TU direct access avoids R_X86_64_REX_GOTPCRELX
* double-dereference in -fPIC PE builds where GOTPCRELX is not relaxed to LEA.
*/
/**
* @brief Return the current count of accumulated contract violations.
*
* Reads @c global_contract_violations directly; same-TU access avoids
* GOT double-dereference in @c -fPIC PE32+ builds where
* @c R_X86_64_REX_GOTPCRELX is not relaxed to a LEA instruction.
*
* @return Number of contract violations recorded since last reset.
*/
int contract_get_violation_count(void) { return global_contract_violations; }
/**
* @brief Reset the contract violation counter to zero.
*
* Call before a fresh round of contract checks so that counts from
* earlier test phases do not accumulate across module boundaries.
*/
void contract_reset_violation_count(void) { global_contract_violations = 0; }
/* ============================================================================
* xorshift64 RNG — deterministic, seeded per-round so each perturbation
* produces a distinct physics state.
* ============================================================================ */
static uint64_t rng_state = 0xDEADBEEFCAFEBABEULL;
/**
* @brief Generate the next pseudo-random 64-bit value via xorshift64.
*
* Uses the global @c rng_state. The xorshift64 parameters (13, 7, 17)
* produce a full-period sequence over all non-zero 64-bit states.
* Caller must seed via @c rng_seed() before starting a new fuzz round
* to ensure different perturbation sequences across rounds.
*
* @return Next pseudo-random 64-bit integer.
*/
static uint64_t contract_rand(void) {
uint64_t x = rng_state;
x ^= x << 13;
x ^= x >> 7;
x ^= x << 17;
rng_state = x;
return x;
}
/**
* @brief Seed the RNG for a given fuzz round.
*
* Derives a deterministic seed from the round index mixed with a
* Fibonacci multiplier (@c 0x9E3779B97F4A7C15) so each round produces
* a distinct, reproducible perturbation sequence regardless of how many
* rounds have previously run.
*
* @param round Zero-based fuzz round index.
*/
static void rng_seed(int round) {
rng_state = 0xDEADBEEFCAFEBABEULL ^ ((uint64_t)(unsigned)round * 0x9E3779B97F4A7C15ULL);
}
/* ============================================================================
* Exec-domain capture and comparison
* ============================================================================ */
/**
* @brief Snapshot the execution-domain fields of a VM into an @c ExecResult.
*
* Captures @c dsp, @c rsp, @c error, and the live portion of the data
* stack (indices 0 … dsp−1). The remainder of @c r->stack is zeroed for
* deterministic @c memcmp() comparisons in @c exec_results_equal().
*
* Only execution-domain fields are captured — physics scalars, heartbeat
* state, and rolling-window counters are deliberately excluded.
*
* @param vm VM instance to snapshot.
* @param r Output @c ExecResult struct to populate.
*/
void capture_exec_result(VM *vm, ExecResult *r) {
r->dsp = vm->dsp;
r->rsp = vm->rsp;
r->error = vm->error;
/* copy only the live portion; zero the rest for deterministic memcmp */
int depth = (vm->dsp > 0) ? vm->dsp : 0;
memcpy(r->stack, vm->data_stack, (size_t)depth * sizeof(cell_t));
if (depth < STACK_SIZE)
memset(&r->stack[depth], 0, (size_t)(STACK_SIZE - depth) * sizeof(cell_t));
}
/**
* @brief Compare two @c ExecResult snapshots for execution-domain equality.
*
* Returns 1 only if @c dsp, @c rsp, @c error, and the live stack contents
* are all identical. Stack comparison uses @c memcmp() over the live
* portion (0 … dsp−1 cells); the zeroed tail guarantees no false
* positives from uninitialised padding.
*
* @param a First snapshot.
* @param b Second snapshot.
* @return 1 if execution-domain is identical, 0 if any field differs.
*/
int exec_results_equal(const ExecResult *a, const ExecResult *b) {
if (a->dsp != b->dsp) return 0;
if (a->rsp != b->rsp) return 0;
if (a->error != b->error) return 0;
int depth = (a->dsp > 0) ? a->dsp : 0;
return memcmp(a->stack, b->stack, (size_t)depth * sizeof(cell_t)) == 0;
}
/* ============================================================================
* Physics snapshot / restore / perturb
*
* These cover the key scalars touched by the seven feedback loops. A word
* that reads any of these will produce a different ExecResult after perturb,
* exposing a violation of A4'.
* ============================================================================ */
/**
* @brief Save the key physics scalars touched by the seven feedback loops.
*
* Captures the eight fields that @c perturb_physics() will randomise:
* @c decay_slope_q48, @c effective_window_size, @c tick_target_ns,
* the three heat percentile thresholds, @c prefetch_attempts, and
* @c total_executions. Used as a bracket pair with @c restore_physics()
* around each fuzz round so the VM returns to a known state.
*
* @param vm VM instance to snapshot.
* @param s Output @c PhysicsSnapshot to populate.
*/
void save_physics(VM *vm, PhysicsSnapshot *s) {
s->decay_slope_q48 = vm->decay_slope_q48;
s->eff_window_size = vm->rolling_window.effective_window_size;
s->tick_target_ns = vm->heartbeat.tick_target_ns;
s->heat_25th = vm->heat_threshold_25th;
s->heat_50th = vm->heat_threshold_50th;
s->heat_75th = vm->heat_threshold_75th;
s->prefetch_attempts = vm->pipeline_metrics.prefetch_attempts;
s->total_executions = vm->rolling_window.total_executions;
}
/**
* @brief Restore the physics scalars from a previously saved snapshot.
*
* Writes back the eight fields saved by @c save_physics(), undoing any
* perturbations made by @c perturb_physics(). Called at the end of each
* fuzz round and after the full @c check_physics_transparent() loop so
* the VM state is clean for the next contract check.
*
* @param vm VM instance to restore.
* @param s Source @c PhysicsSnapshot to restore from.
*/
void restore_physics(VM *vm, const PhysicsSnapshot *s) {
vm->decay_slope_q48 = s->decay_slope_q48;
vm->rolling_window.effective_window_size = s->eff_window_size;
vm->heartbeat.tick_target_ns = s->tick_target_ns;
vm->heat_threshold_25th = s->heat_25th;
vm->heat_threshold_50th = s->heat_50th;
vm->heat_threshold_75th = s->heat_75th;
vm->pipeline_metrics.prefetch_attempts = s->prefetch_attempts;
vm->rolling_window.total_executions = s->total_executions;
}
/**
* @brief Randomly perturb key physics scalars to expose A4' violations.
*
* Seeds the RNG via @c rng_seed(@p round) for deterministic but distinct
* perturbations per round, then overwrites the eight tracked physics
* fields with random values that still satisfy their well-formedness
* invariants:
*
* - @c decay_slope_q48: LSB forced to 1 (must be > 0 per @c slope_wf)
* - @c effective_window_size: [1, ROLLING_WINDOW_SIZE] (never 0)
* - @c tick_target_ns: LSB forced to 1 (must be > 0 per @c hb_state_wf)
* - Heat thresholds: arbitrary positive values (no strict invariant)
* - @c prefetch_attempts / @c total_executions: arbitrary counts
*
* After perturbation, running the same FORTH input must produce an
* identical @c ExecResult; divergence is an A4' violation.
*
* @param vm VM instance to perturb.
* @param round Fuzz round index (used to seed the RNG).
*/
void perturb_physics(VM *vm, int round) {
rng_seed(round);
/* decay_slope_q48: must be > 0 per slope_wf */
vm->decay_slope_q48 = contract_rand() | 1ULL;
/* effective_window_size: must be in [1, ROLLING_WINDOW_SIZE] */
uint64_t w = contract_rand() % (uint64_t)ROLLING_WINDOW_SIZE;
vm->rolling_window.effective_window_size = (uint32_t)(w == 0 ? 1 : w);
/* tick_target_ns: must be > 0 per hb_state_wf */
vm->heartbeat.tick_target_ns = contract_rand() | 1ULL;
/* heat thresholds: arbitrary signed values */
vm->heat_threshold_25th = (cell_t)(contract_rand() & 0x7FFF);
vm->heat_threshold_50th = (cell_t)(contract_rand() & 0xFFFF);
vm->heat_threshold_75th = (cell_t)(contract_rand() & 0x1FFFF);
/* pipeline and window counters */
vm->pipeline_metrics.prefetch_attempts = contract_rand();
vm->rolling_window.total_executions = contract_rand();
}
/* ============================================================================
* A4' contract check
* ============================================================================ */
/**
* @brief A4' contract check — verify a word is transparent to physics state.
*
* Axiom A4' (physics transparency): a FORTH word's execution-domain
* result (@c ExecResult) must be identical regardless of the values of
* the seven physics feedback-loop scalars.
*
* Protocol:
* 1. Run @p input with current (unperturbed) physics; capture baseline.
* 2. For each of @p fuzz_rounds rounds: seed RNG, perturb physics,
* re-run @p input, capture result, compare to baseline.
* 3. On divergence, log the violation and increment
* @c global_contract_violations.
* 4. Always restore original physics state before returning.
*
* Error-expected tests (@p should_error) and unimplemented words
* (@p implemented == 0) are skipped: exec-equivalent divergence is
* legitimate for error paths.
*
* @param vm VM instance.
* @param word_name Human-readable word name for diagnostic messages.
* @param input FORTH source string to execute (same each round).
* @param should_error Non-zero if the test is expected to raise an error.
* @param implemented Non-zero if the word is implemented and should be checked.
* @param fuzz_rounds Number of perturbation rounds; 0 → CONTRACT_DEFAULT_FUZZ_ROUNDS.
* @return 1 if all rounds passed (or test skipped), 0 on any violation.
*/
int check_physics_transparent(VM *vm, const char *word_name,
const char *input,
int should_error, int implemented,
int fuzz_rounds) {
/* Skip error-expected tests: exec-equiv may legitimately differ */
if (!implemented || should_error) return 1;
int rounds = (fuzz_rounds > 0) ? fuzz_rounds : CONTRACT_DEFAULT_FUZZ_ROUNDS;
/* --- Baseline run with current (unperturbed) physics --- */
vm->error = 0;
vm->dsp = -1;
vm->rsp = -1;
vm->exit_colon = 0;
vm->abort_requested = 0;
vm_interpret(vm, input);
ExecResult baseline;
capture_exec_result(vm, &baseline);
PhysicsSnapshot saved;
save_physics(vm, &saved);
int ok = 1;
for (int r = 0; r < rounds && ok; r++) {
perturb_physics(vm, r);
vm->error = 0;
vm->dsp = -1;
vm->rsp = -1;
vm->exit_colon = 0;
vm->abort_requested = 0;
vm_interpret(vm, input);
ExecResult fuzzed;
capture_exec_result(vm, &fuzzed);
if (!exec_results_equal(&baseline, &fuzzed)) {
log_message(LOG_ERROR,
"[A4' CONTRACT] VIOLATION: %s '%s' result changed under physics perturbation (round %d)",
word_name, input, r);
log_message(LOG_ERROR,
" baseline dsp=%d fuzzed dsp=%d", baseline.dsp, fuzzed.dsp);
ok = 0;
global_contract_violations++;
}
vm->dsp = -1;
vm->rsp = -1;
vm->error = 0;
}
restore_physics(vm, &saved);
vm->dsp = -1;
vm->rsp = -1;
vm->error = 0;
return ok;
}
/* ============================================================================
* A1 contract check
* ============================================================================ */
/**
* @brief A1 contract check — verify @c vm_tick() does not modify the execution domain.
*
* Axiom A1 (heartbeat isolation): the background heartbeat tick must never
* alter stacks, error state, or any other execution-domain field observable
* by FORTH words. This function captures an @c ExecResult before and after
* one @c vm_tick() call and compares them with @c exec_results_equal().
*
* On violation, logs @c [A1 CONTRACT] VIOLATION with before/after dsp and
* rsp values, and increments @c global_contract_violations.
*
* @param vm VM instance; stacks and error state must already be in a known
* reference state before calling.
* @return 1 if the heartbeat left the execution domain unchanged, 0 on violation.
*/
int assert_heartbeat_safe(VM *vm) {
ExecResult before, after;
capture_exec_result(vm, &before);
vm_tick(vm);
capture_exec_result(vm, &after);
if (!exec_results_equal(&before, &after)) {
log_message(LOG_ERROR,
"[A1 CONTRACT] VIOLATION: vm_tick() modified exec-equiv fields");
log_message(LOG_ERROR,
" dsp before=%d after=%d rsp before=%d after=%d",
before.dsp, after.dsp, before.rsp, after.rsp);
global_contract_violations++;
return 0;
}
return 1;
}
v3/src/test_runner/test_runner.c
+272
View File
@@ -0,0 +1,272 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
All rights reserved.
This file is part of the StarForth project.
Licensed under the StarForth License, Version 1.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at:
https://github.com/star.4th@proton.me/StarForth/LICENSE.txt
This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose, and noninfringement.
See the License for the specific language governing permissions and
limitations under the License.
*/
#include "include/test_runner.h"
#include "include/test_contracts.h"
#include "../../include/log.h"
#include <stdint.h>
#ifdef __STARKERNEL__
#include "platform_time.h"
/* Kernel uses sf_monotonic_ns() for timing */
/* strcmp provided by shim.c */
extern int strcmp(const char *a, const char *b);
#else
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#endif
/** @brief Global statistics for test execution */
#ifdef __STARKERNEL__
/* Ensure visibility for GOT-based access with -fPIC -fvisibility=hidden */
__attribute__((visibility("default")))
#endif
TestStats global_test_stats = {0, 0, 0, 0, 0};
/*
* Same-TU accessor — avoids R_X86_64_REX_GOTPCRELX double-dereference in
* -fPIC PE builds where struct access generates GOT-indirect code that the
* PE linker does not relax.
*/
void test_stats_accumulate(int tests, int pass, int fail, int skip, int error)
{
global_test_stats.total_tests += tests;
global_test_stats.total_pass += pass;
global_test_stats.total_fail += fail;
global_test_stats.total_skip += skip;
global_test_stats.total_error += error;
}
/** @brief Flag indicating if benchmark mode is enabled */
static int benchmark_mode = 0;
/** @brief Number of iterations for benchmark tests */
static int benchmark_iterations = 1000;
/**
* @brief Get current time in nanoseconds
*
* Uses platform-specific timing: sf_monotonic_ns() on kernel, clock() on hosted.
*
* @return Current time in nanoseconds, or 0 on error
*/
static uint64_t get_time_ns(void) {
#ifdef __STARKERNEL__
return sf_monotonic_ns();
#else
clock_t t = clock();
if (t == (clock_t)(-1)) {
return 0; /* Error case */
}
/* Convert to nanoseconds: (clock_ticks / CLOCKS_PER_SEC) * 1,000,000,000 */
return (uint64_t)((double) t / CLOCKS_PER_SEC * 1000000000.0);
#endif
}
/* Test modules in POST (Power-On Self Test) order:
* 1. Unit tests (foundational math/algorithms) run FIRST
* 2. Dictionary tests (FORTH word validation) run after POST passes
*/
static TestModule test_modules[] = {
/* === Dictionary Tests: FORTH-79 Word Validation === */
{"Stack Words", NULL, 0, run_stack_words_tests}, /* Module 5 */
{"Return Stack Words", NULL, 0, run_return_stack_words_tests}, /* Module 6 */
{"Memory Words", NULL, 0, run_memory_words_tests}, /* Module 7 */
{"Arithmetic Words", NULL, 0, run_arithmetic_words_tests}, /* Module 8 */
{"Logical Words", NULL, 0, run_logical_words_tests}, /* Module 9 */
{"Mixed Arithmetic Words", NULL, 0, run_mixed_arithmetic_words_tests}, /* Module 10 */
{"Double Words", NULL, 0, run_double_words_tests}, /* Module 11 */
{"Format Words", NULL, 0, run_format_words_tests}, /* Module 12 */
{"String Words", NULL, 0, run_string_words_tests}, /* Module 13 */
{"I/O Words", NULL, 0, run_io_words_tests}, /* Module 14 */
{"Block Words", NULL, 0, run_block_words_tests}, /* Module 15 */
{"Dictionary Words", NULL, 0, run_dictionary_words_tests}, /* Module 16 */
{"Dictionary Manipulation Words", NULL, 0, run_dictionary_manipulation_words_tests}, /* Module 17 */
{"Vocabulary Words", NULL, 0, run_vocabulary_words_tests}, /* Module 18 */
{"System Words", NULL, 0, run_system_words_tests}, /* Module 19 */
{"Defining Words", NULL, 0, run_defining_words_tests}, /* Module 20 */
{"Control Words", NULL, 0, run_control_words_tests}, /* Module 21 */
{"StarForth Words", NULL, 0, run_starforth_words_tests}, /* Module 22 */
{"ACL Words", NULL, 0, run_acl_words_tests}, /* Module 23: Word-Level ACL System */
{"Mama FORTH Words", NULL, 0, run_mama_forth_words_tests}, /* Module 24: Capsule System M7.1 */
{"Q48.16 Words", NULL, 0, run_q48_words_tests}, /* Module 25: Q48.16 Fixed-Point Arithmetic */
{"Inference Engine Words", NULL, 0, run_inference_words_tests}, /* Module 26: SSM Inference (proof-covered subset) */
{"Physics Freeze Words", NULL, 0, run_physics_freeze_words_tests}, /* Module 27: Physics Freeze (proof-covered subset) */
{NULL, NULL, 0, NULL} /* End marker */
};
/**
* @brief Enable benchmark mode for test execution
*
* @param iterations Number of times each test should be repeated
*/
void enable_benchmark_mode(int iterations) {
benchmark_mode = 1;
benchmark_iterations = iterations;
log_message(LOG_INFO, "Benchmark mode enabled: %d iterations per module", iterations);
}
/**
* @brief Run all test modules with optional benchmarking
*
* Executes all registered test modules sequentially, collecting statistics
* and/or benchmark data depending on the current mode.
*
* @param vm Pointer to the Forth virtual machine instance
*/
void run_all_tests(VM *vm) {
log_message(LOG_INFO, "Starting comprehensive FORTH-79 modular test suite...");
log_message(LOG_INFO, "==============================================");
/* Reset global statistics */
global_test_stats.total_tests = 0;
global_test_stats.total_pass = 0;
global_test_stats.total_fail = 0;
global_test_stats.total_skip = 0;
global_test_stats.total_error = 0;
contract_reset_violation_count();
/* Run each test module */
for (int i = 0; test_modules[i].module_name != NULL; i++) {
TestModule const*module = &test_modules[i];
log_message(LOG_INFO, "\n=== Testing Module: %s ===", module->module_name);
if (module->run_module_tests != NULL) {
module->run_module_tests(vm);
} else {
log_message(LOG_WARN, "Module %s: No tests implemented yet", module->module_name);
}
}
/* Print test summary */
log_message(LOG_INFO, "FINAL TEST SUMMARY:");
log_message(LOG_INFO, " Total tests run: %d", global_test_stats.total_tests);
log_message(LOG_INFO, " Passed: %d", global_test_stats.total_pass);
log_message(LOG_INFO, " Failed: %d", global_test_stats.total_fail);
log_message(LOG_INFO, " Stubs (not yet implemented): %d", global_test_stats.total_skip);
log_message(LOG_INFO, " Errors: %d", global_test_stats.total_error);
if (global_test_stats.total_fail == 0 && global_test_stats.total_error == 0) {
log_message(LOG_INFO, "ALL IMPLEMENTED TESTS PASSED!");
} else {
log_message(LOG_ERROR, "%d tests FAILED or had ERRORS!",
global_test_stats.total_fail + global_test_stats.total_error);
}
if (contract_get_violation_count() > 0) {
log_message(LOG_ERROR, " Contract violations (A4'/A1): %d *** AXIOM WITNESSES FAILED ***",
contract_get_violation_count());
} else {
log_message(LOG_INFO, " Contract checks (A4'/A1): all passed");
}
log_message(LOG_INFO, "==============================================");
}
/**
* @brief Run tests for a specific module
*
* @param vm Pointer to the Forth virtual machine instance
* @param module_name Name of the module to test
*/
void run_module_tests(VM *vm, const char *module_name) {
for (int i = 0; test_modules[i].module_name != NULL; i++) {
if (strcmp(test_modules[i].module_name, module_name) == 0) {
if (benchmark_mode) {
log_message(LOG_INFO, "Benchmarking module: %s", module_name);
if (test_modules[i].run_module_tests != NULL) {
/* Warmup */
test_modules[i].run_module_tests(vm);
/* Benchmark */
uint64_t start_time = get_time_ns();
for (int iter = 0; iter < benchmark_iterations; iter++) {
test_modules[i].run_module_tests(vm);
}
uint64_t end_time = get_time_ns();
uint64_t total_time = end_time - start_time;
double runs_per_second = (double) benchmark_iterations * 1000000000.0 / total_time;
log_message(LOG_INFO, " %.0f runs/sec | %.1f μs/run",
runs_per_second,
(double) total_time / benchmark_iterations / 1000.0);
} else {
log_message(LOG_WARN, "No tests implemented for module: %s", module_name);
}
} else {
log_message(LOG_INFO, "Running tests for module: %s", module_name);
if (test_modules[i].run_module_tests != NULL) {
test_modules[i].run_module_tests(vm);
} else {
log_message(LOG_WARN, "No tests implemented for module: %s", module_name);
}
}
return;
}
}
log_message(LOG_ERROR, "Unknown test module: %s", module_name);
}
/**
* @brief Run tests for a specific Forth word
*
* Searches all modules for tests related to the specified word and executes them.
*
* @param vm Pointer to the Forth virtual machine instance
* @param word_name Name of the Forth word to test
*/
void run_word_tests(VM *vm, const char *word_name) {
(void)vm;
log_message(LOG_INFO, "Searching for tests for word: %s", word_name);
int found = 0;
for (int i = 0; test_modules[i].module_name != NULL; i++) {
/* This would need to be implemented in each module */
/* For now, just run all tests - individual word testing can be added later */
}
if (!found) {
log_message(LOG_WARN, "No tests found for word: %s", word_name);
}
}