cs-zuordnung-lauf zerlegen + LISP-Testarchitektur vereinheitlichen
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
co-authored by
Claude Opus 4.8
Claude Opus 4.8
parent
52d92f0da6
commit
dbc6c585bf
+153
-15
@@ -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*))
|
||||
|
||||
Reference in New Issue
Block a user