mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs-zuordnung-lauf zerlegen + LISP-Testarchitektur vereinheitlichen

Browse Source 
cs-zuordnung-lauf (~230 Zeilen, ~26 Locals) in sieben benannte
Routinen zerlegt (cs-sammle-bloecke, cs-scanner-zuordnen,
cs-separatoren-zuordnen, cs-korrektur-vermerken, cs-scanner-distanz-
melden, cs-anzahl-schreiben, cs-bericht-ausgeben); die Engine ist
jetzt ein schlanker Orchestrator. Verhalten unveraendert.

Dadurch ist die rein geometrische Zuordnungslogik von den Entity-
Zugriffen getrennt und unittest-faehig: neuer Block tu-tests-sepscan
mit 30 Tests fuer cs-in-box/cs-bump/cs-carrier-by-id/cs-assign/
cs-nearest-two/cs-resolve-sensor (Carrier-Records als plain Listen,
keine Zeichnung noetig).

Testarchitektur (Laden) vereinheitlicht: lazy Feature-Module
(GeruestInsert, count_sep_scan) werden AUSSCHLIESSLICH in test_unit.scr
auf .scr-Top-Level geladen. Grund: in BricsCAD werden per load
definierte Funktionen erst nach Rueckkehr zum Top-Level sichtbar - ein
load in c:TEST_UNIT oder einem gecatchten Testblock bindet sie im
selben Durchlauf nicht. Die Testbloecke laden nichts mehr, sie pruefen
nur per atoms-family. Runner gehaertet (tu-run-block faengt harte
Fehler je Block ab -> FAIL statt Suite-Abbruch, Report immer da).

Nebenbei aufgeraeumt: tote tests.lsp-Referenz in ssg_load.lsp entfernt
(Datei laengst geloescht, blockierte headless den kompletten Testlauf).

Voller LISP-Unit-Lauf jetzt 226/226 gruen.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
Michael Stangl
2026-09-18 14:31:35 +02:00
co-authored by Claude Opus 4.8
parent 52d92f0da6
commit dbc6c585bf
4 changed files with 446 additions and 219 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/test_unit.lsp
+153 -15
View File
@@ -19,6 +19,20 @@
;; Ergebnis:
;; Konsole: PASS/FAIL je Test + Zusammenfassung
;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen)
;;
;; Ladearchitektur (EINHEITLICH):
;; Das Laden der zu testenden Module passiert AUSSCHLIESSLICH auf .scr-
;; Top-Level in tests/test_unit.scr - die Core-Module ueber ssg_load.lsp,
;; die lazy Feature-Module (GeruestInsert, count_sep_scan) per explizitem
;; load. Die Testbloecke hier laden NICHTS nach; sie pruefen nur per
;; atoms-family, ob ihr Modul vorhanden ist, und ueberspringen sich sonst
;; mit einer FAIL-Meldung.
;; Grund: In BricsCAD werden per load definierte Funktionen erst nach
;; Rueckkehr zum Top-Level sichtbar. Ein load INNERHALB von c:TEST_UNIT
;; oder eines per vl-catch-all-apply gecatchten Testblocks bindet die
;; frisch definierten Funktionen im laufenden Durchlauf NICHT (beobachtet:
;; geruest-id-string/cs-in-box blieben ungebunden). Darum gehoert alles
;; Laden vor den (c:TEST_UNIT)-Aufruf ins .scr.
;; ============================================================
@@ -538,10 +552,9 @@
(defun tu-tests-geruest ( / _eintrag _gruppe _teile _konfig _rec _pfad _f
_zurueck _bgtest _saeulen)
(princ "\n[GeruestInsert]")
(if (and (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN")))
(atoms-family 1 '("SSG-ENSURE")))
(ssg-ensure "GeruestInsert")
)
;; GeruestInsert ist ein lazy Feature-Modul (nicht in der Core-Ladeliste).
;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur
;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur).
(if (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN")))
(tu-record nil "geruest/modul" "GeruestInsert.lsp nicht geladen")
(progn
@@ -694,6 +707,127 @@
)
;; ------------------------------------------------------------
;; TESTS: count_sep_scan.lsp - geometrische Sensor-Zuordnung
;;
;; Testet die durch die Zerlegung von cs-zuordnung-lauf isolierte,
;; rein funktionale Kernlogik: Carrier-Records sind plain Listen
;; (ename tagS tagP minx miny maxx maxy cx cy id label), Sensoren
;; sind Punkte (x y). Kein ssget/entget/entmod - der ename an
;; Position 0 wird von den Geometrie-Routinen nie dereferenziert,
;; darum genuegt ein Symbol-Platzhalter. *senstol* wird fuer
;; deterministische Ergebnisse explizit gesetzt (sonst cfg-abhaengig).
;; ------------------------------------------------------------
;; Record-Konstruktor fuers Testen: baut einen Carrier-Record so, wie
;; ihn cs-sammle-bloecke liefert - nur die Box-/Zentrum-/ID-Felder
;; (Index 3-9), die die Geometrie-Routinen lesen, sind relevant; ename
;; und label sind reine Platzhalter.
;; (name minx miny maxx maxy id) -> voller Carrier-Record
(defun tu-mk-carr (name minx miny maxx maxy id)
(list name "ANZAHL_SCANNER" "ANZAHL_SEPARATOR"
minx miny maxx maxy
(/ (+ minx maxx) 2.0) (/ (+ miny maxy) 2.0)
id (strcat "L-" name)))
(defun tu-tests-sepscan ( / _senstol-alt _a _b _c _carr _grid _res)
(princ "\n[count_sep_scan]")
;; count_sep_scan ist ein lazy Feature-Modul (nicht in der Core-Ladeliste).
;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur
;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur).
(if (null (atoms-family 1 '("CS-RESOLVE-SENSOR")))
(tu-record nil "sepscan/modul" "count_sep_scan.lsp nicht geladen")
(progn
(setq _senstol-alt (if (boundp '*senstol*) *senstol*))
(setq *senstol* 0.0)
;; --- cs-in-box: Punkt in Carrier-Box (X/Y, Z ignoriert) ---
(setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001"))
(tu-true "cs-in-box/mitte" (cs-in-box '(50.0 50.0) _a))
(tu-true "cs-in-box/rand" (cs-in-box '(0.0 0.0) _a))
(tu-nil "cs-in-box/ausserhalb-x" (cs-in-box '(150.0 50.0) _a))
(tu-nil "cs-in-box/ausserhalb-y" (cs-in-box '(50.0 -1.0) _a))
;; --- *senstol* vergroessert die Box ---
(setq *senstol* 10.0)
(tu-true "cs-in-box/toleranz-innen" (cs-in-box '(105.0 50.0) _a))
(tu-nil "cs-in-box/toleranz-aussen" (cs-in-box '(111.0 50.0) _a))
(setq *senstol* 0.0)
;; --- cs-bump: Zaehler je ename hochzaehlen ---
(tu-eq "cs-bump/neu" '(("k" . 1)) (cs-bump nil "k"))
(tu-eq "cs-bump/erhoeht" '(("k" . 2)) (cs-bump '(("k" . 1)) "k"))
(tu-eq "cs-bump/zweiter-key"
'(("m" . 1) ("k" . 1)) (cs-bump '(("k" . 1)) "m"))
;; --- cs-carrier-by-id: Record ueber ID (Feld 9) finden ---
(setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002"))
(setq _carr (list _a _b))
(tu-eq "cs-carrier-by-id/treffer" _b (cs-carrier-by-id "0002" _carr))
(tu-nil "cs-carrier-by-id/fehlt" (cs-carrier-by-id "9999" _carr))
(tu-nil "cs-carrier-by-id/leer" (cs-carrier-by-id "" _carr))
(tu-nil "cs-carrier-by-id/nil" (cs-carrier-by-id nil _carr))
;; --- cs-assign: BBox-Zuordnung ueber das Grid ---
;; Zwei getrennte Boxen: Punkt in genau einer -> diese.
(setq _grid (cs-grid-build _carr))
(tu-eq "cs-assign/box-a" _a (cs-assign '(50.0 50.0) _grid))
(tu-eq "cs-assign/box-b" _b (cs-assign '(250.0 50.0) _grid))
(tu-nil "cs-assign/keine-box" (cs-assign '(1000.0 1000.0) _grid))
;; Ueberlappende Boxen -> naechstes Box-Zentrum gewinnt (Tiebreak).
;; C: 0..100, D: 40..200; Punkt (45,50) liegt in beiden,
;; C-Zentrum (50,50) ist naeher als D-Zentrum (120,50).
(setq _a (tu-mk-carr "C" 0.0 0.0 100.0 100.0 "0003"))
(setq _b (tu-mk-carr "D" 40.0 0.0 200.0 100.0 "0004"))
(setq _grid (cs-grid-build (list _a _b)))
(tu-eq "cs-assign/overlap-naechstes-zentrum"
_a (cs-assign '(45.0 50.0) _grid))
;; --- cs-nearest-two: die zwei naechsten Carrier nach Zentrum ---
;; Zentren: A(50,50) B(250,50) C(50,250). Punkt (60,60):
;; naechster A, zweiter B (dx 190 < dy 190? -> Abstand B=~194, C=~190).
(setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001"))
(setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002"))
(setq _c (tu-mk-carr "C" 0.0 200.0 100.0 300.0 "0003"))
(setq _res (cs-nearest-two '(60.0 60.0) (list _a _b _c)))
(tu-eq "cs-nearest-two/naechster" _a (nth 0 _res))
(tu-true "cs-nearest-two/zweiter-vorhanden" (nth 2 _res))
;; Abstand zum naechsten (A-Zentrum 50,50) = sqrt(10^2+10^2) ~ 14.14
(tu-eqf "cs-nearest-two/best-dist"
(distance '(60.0 60.0) '(50.0 50.0)) (nth 1 _res))
;; Nur ein Carrier -> zweiter ist nil.
(setq _res (cs-nearest-two '(60.0 60.0) (list _a)))
(tu-eq "cs-nearest-two/einzeln-best" _a (nth 0 _res))
(tu-nil "cs-nearest-two/einzeln-kein-zweiter" (nth 2 _res))
;; --- cs-resolve-sensor: der Entscheider bbox/distance/none ---
;; Punkt in einer Box -> modus 'bbox, kein Distanzfeld.
(setq _grid (cs-grid-build (list _a _b _c)))
(setq _res (cs-resolve-sensor '(50.0 50.0) (list _a _b _c) _grid))
(tu-eq "cs-resolve/bbox-modus" 'bbox (nth 0 _res))
(tu-eq "cs-resolve/bbox-rec" _a (nth 1 _res))
(tu-nil "cs-resolve/bbox-kein-dist" (nth 2 _res))
;; Punkt ausserhalb aller Boxen, aber Carrier vorhanden -> 'distance.
(setq _res (cs-resolve-sensor '(1000.0 1000.0) (list _a _b _c) _grid))
(tu-eq "cs-resolve/distance-modus" 'distance (nth 0 _res))
(tu-true "cs-resolve/distance-rec" (nth 1 _res))
(tu-true "cs-resolve/distance-dist" (nth 2 _res))
;; Gar keine Carrier -> 'none.
(setq _grid (cs-grid-build nil))
(setq _res (cs-resolve-sensor '(50.0 50.0) nil _grid))
(tu-eq "cs-resolve/none-modus" 'none (nth 0 _res))
(tu-nil "cs-resolve/none-rec" (nth 1 _res))
;; *senstol* wieder herstellen
(setq *senstol* _senstol-alt)
)
)
)
;; ------------------------------------------------------------
;; REPORT SCHREIBEN
;; ------------------------------------------------------------
@@ -722,23 +856,27 @@
;; ------------------------------------------------------------
;; BEFEHL: TEST_UNIT
;; ------------------------------------------------------------
;; Testblock geschuetzt aufrufen: ein harter LISP-Fehler in einem Block
;; wird als FAIL erfasst, statt c:TEST_UNIT abzubrechen und damit den
;; Report zu verhindern. Der Blockname (String) wird per read zur Funktion.
(defun tu-run-block (fn / res)
(setq res (vl-catch-all-apply (read fn) nil))
(if (vl-catch-all-error-p res)
(tu-record nil (strcat fn "/ausfuehrung")
(strcat "harter Fehler: " (vl-catch-all-error-message res))))
)
(defun c:TEST_UNIT ( / out-dir report)
(tu-reset)
(princ "\n================================================================")
(princ "\n TEST_UNIT - LISP-Standardfunktionen")
(princ "\n================================================================")
(tu-tests-core)
(tu-tests-lang)
(tu-tests-id)
(tu-tests-vfcore)
(tu-tests-export)
(tu-tests-gf)
(tu-tests-omni)
(tu-tests-kreisel)
(tu-tests-sepliste)
(tu-tests-json)
(tu-tests-geruest)
(foreach fn '("tu-tests-core" "tu-tests-lang" "tu-tests-id" "tu-tests-vfcore"
"tu-tests-export" "tu-tests-gf" "tu-tests-omni" "tu-tests-kreisel"
"tu-tests-sepliste" "tu-tests-json" "tu-tests-geruest"
"tu-tests-sepscan")
(tu-run-block fn))
(princ "\n\n----------------------------------------------------------------")
(princ (strcat "\n Gesamt: " (itoa (+ *tu-pass* *tu-fail*))
tests/test_unit.scr
+8
View File
@@ -2,6 +2,14 @@
; Laedt SSG_LIB + die Unit-Tests, fuehrt TEST_UNIT aus und beendet BricsCAD.
; Pfadunabhaengig ueber DXFMAKRO (von setenv.bat gesetzt).
(load (strcat (getenv "DXFMAKRO") "/Lisp/ssg_load.lsp"))
; Lazy Feature-Module, die einzelne Unit-Tests brauchen, hier auf .scr-Top-
; Level laden. In BricsCAD werden per load definierte Funktionen erst nach
; Rueckkehr zum Top-Level sichtbar - ein load INNERHALB von c:TEST_UNIT
; (oder eines gecatchten Testblocks) bindet sie im selben Durchlauf nicht.
; DIES ist die einzige Ladestelle: Testet ein neuer Block ein weiteres lazy
; Modul, gehoert dessen load-Zeile HIER dazu (nicht in test_unit.lsp).
(load (strcat (getenv "DXFM_LISP") "/GeruestInsert.lsp") "GeruestInsert.lsp nicht gefunden")
(load (strcat (getenv "DXFM_LISP") "/count_sep_scan.lsp") "count_sep_scan.lsp nicht gefunden")
(load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
(c:TEST_UNIT)
(command "_.QUIT")