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
Lisp/count_sep_scan.lsp
+284 -202
View File
@@ -605,59 +605,20 @@
)
)
;;; ============================================================
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
;;; csv:run-export).
;;;
;;; label = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
;;; (nur fuer den interaktiven Befehl sinnvoll - der
;;; automatische Aufruf aus csv:run-export laesst dies aus,
;;; damit die Export-Konsole kompakt bleibt).
;;;
;;; Setzt als Nebenwirkung:
;;; *cs-scanner-ergaenzt* - Liste (scanner-id carrier-id
;;; distanz-mm strittig-p
;;; zweiter-carrier-id zweite-distanz-mm)
;;; je per Abstand (nicht per BBox)
;;; zugeordnetem Scanner.
;;; *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
;;; fuer strittige Scanner-Zuordnungen,
;;; von csv:block-to-json ausgelesen.
;;; *cs-korrekturen* - Liste (typ-wort sensor-id alt-id
;;; neu-id) je Sensor, dessen gespeicherte
;;; ZUORDNUNG nicht zur Geometrie passte
;;; und ueberschrieben wurde (Report).
;;; ============================================================
(defun cs-zuordnung-lauf (label verbose /
mss ss i ent ed nm bb cx cy lbl carrier-id
carriers grid scanlist seplist sk pt
scanCounts sepCounts n-scan-unassigned n-sep-unassigned
n-strittig n-zuordnung-fehlt alt
s sent spt res mode rec best-d second-rec second-d
vorgabe-id vorgabe-rec
scanner-id contested handle
en nm2 ns nsep newS newP okS okP eintrag)
(setq carriers nil scanlist nil seplist nil
n-zuordnung-fehlt 0 n-scan-unassigned 0 n-sep-unassigned 0 n-strittig 0)
(setq *cs-scanner-ergaenzt* nil)
(setq *cs-scanner-warnung-by-handle* nil)
(setq *cs-korrekturen* nil)
(setq *senstol* (cs-senstol))
;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
;; Carrier bekommen haben oder umgekehrt).
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
(if mss (command "_.ERASE" mss ""))
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
(princ (ssg-textf "sens-start" (list label)))
;;; ------------------------------------------------------------
;;; Alle INSERTs der Zeichnung in Carrier-, Scanner- und Separator-
;;; Listen einsortieren.
;;; Rueckgabe: (carriers scanlist seplist)
;;; carriers = Liste von Records (ename tagScan tagSep minx miny
;;; maxx maxy cx cy id label)
;;; scanlist/seplist = Liste von (ename einfuegepunkt)
;;; Ein Carrier ohne ermittelbare Bounding-Box wird gemeldet und
;;; uebersprungen (kann sonst nicht zugeordnet werden).
;;; ------------------------------------------------------------
(defun cs-sammle-bloecke ( / ss i ent ed nm bb cx cy lbl carrier-id
sk pt carriers scanlist seplist)
(setq ss (ssget "_X" '((0 . "INSERT"))))
(if (null ss)
(princ (ssg-textf "sens-no-inserts" (list label)))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
@@ -693,167 +654,288 @@
)
(setq i (1+ i))
)
)
)
(list carriers scanlist seplist)
)
(setq grid (cs-grid-build carriers))
(setq scanCounts nil sepCounts nil)
;;; ------------------------------------------------------------
;;; Abweichende gespeicherte ZUORDNUNG als Korrektur in
;;; *cs-korrekturen* vermerken, BEVOR sie ueberschrieben wird
;;; (Selbstheilung eingefrorener/verwaister Zuordnungen). typ-wort
;;; ist "Scanner" oder "Separator"; neu-id die geometrisch/vorgegeben
;;; ermittelte Carrier-ID.
;;; ------------------------------------------------------------
(defun cs-korrektur-vermerken (sent typ-wort neu-id / alt)
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and alt (/= alt "") (/= alt neu-id))
(setq *cs-korrekturen*
(cons (list typ-wort (cs-get-att-str sent "ID") alt neu-id)
*cs-korrekturen*)))
)
;; --- Scanner zuordnen (inkl. Distanz-Fallback + Strittig-Erkennung) ---
(foreach s scanlist
(setq sent (car s) spt (cadr s))
;;; ------------------------------------------------------------
;;; Strittige Distanz-Zuordnung eines Scanners protokollieren:
;;; Eintrag in *cs-scanner-ergaenzt* (immer) und - bei zu knappem
;;; Abstand zum zweitnaechsten Carrier - eine Warnung in
;;; *cs-scanner-warnung-by-handle* (von csv:block-to-json gelesen).
;;; Rueckgabe: T, wenn die Zuordnung strittig ist.
;;; ------------------------------------------------------------
(defun cs-scanner-distanz-melden (sent rec best-d second-rec second-d /
scanner-id contested handle)
(setq scanner-id (cs-get-att-str sent "ID"))
(setq contested (and second-rec
(<= (- second-d best-d) (cs-strittig-diff-mm))))
(setq *cs-scanner-ergaenzt*
(cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
contested
(if contested (nth 9 second-rec) nil)
(if contested (fix (+ second-d 0.5)) nil))
*cs-scanner-ergaenzt*))
(if contested
(progn
(setq handle (cdr (assoc 5 (entget sent))))
(setq *cs-scanner-warnung-by-handle*
(cons (cons handle
(strcat "Distanz-Zuordnung unsicher: "
(nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
(nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
*cs-scanner-warnung-by-handle*))
)
)
contested
)
;;; ------------------------------------------------------------
;;; Scanner den Carriern zuordnen (rein geometrisch: BBox, sonst
;;; naechster Carrier). Setzt je zugeordnetem Scanner das ZUORDNUNG-
;;; Attribut und fuellt *cs-scanner-ergaenzt*/*cs-scanner-warnung-by-
;;; handle* (Distanz-Fallback + Strittig-Report).
;;; Rueckgabe: (scanCounts n-scan-unassigned n-strittig n-zuordnung-fehlt)
;;; ------------------------------------------------------------
(defun cs-scanner-zuordnen (scanlist carriers grid /
scanCounts n-scan-unassigned n-strittig
n-zuordnung-fehlt s sent spt res mode rec
best-d second-rec second-d)
(setq scanCounts nil n-scan-unassigned 0 n-strittig 0 n-zuordnung-fehlt 0)
(foreach s scanlist
(setq sent (car s) spt (cadr s))
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res)
best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
(cond
((eq mode 'none)
(setq n-scan-unassigned (1+ n-scan-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq scanCounts (cs-bump scanCounts (car rec)))
(cs-korrektur-vermerken sent "Scanner" (nth 9 rec))
(if (member mode '(bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
(if (eq mode 'distance)
(if (cs-scanner-distanz-melden sent rec best-d second-rec second-d)
(setq n-strittig (1+ n-strittig))))
)
)
)
(setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))
(list scanCounts n-scan-unassigned n-strittig n-zuordnung-fehlt)
)
;;; ------------------------------------------------------------
;;; Separatoren den Carriern zuordnen. Wie cs-scanner-zuordnen, aber
;;; ohne Strittig-Report; zusaetzlich hat eine festgenagelte Zuordnung
;;; (verpackter Separator, *cs-sep-fix-by-handle*) Vorrang vor der
;;; Geometrie - nur wenn der genannte Carrier nicht (mehr) existiert,
;;; wird geometrisch zugeordnet. Bei mode 'vorgabe wird der geschriebene
;;; Wert NICHT als Korrektur gemeldet (er ist die Vorgabe selbst).
;;; Rueckgabe: (sepCounts n-sep-unassigned n-zuordnung-fehlt)
;;; ------------------------------------------------------------
(defun cs-separatoren-zuordnen (seplist carriers grid /
sepCounts n-sep-unassigned n-zuordnung-fehlt
s sent spt res mode rec vorgabe-id vorgabe-rec)
(setq sepCounts nil n-sep-unassigned 0 n-zuordnung-fehlt 0)
(foreach s seplist
(setq sent (car s) spt (cadr s))
(setq vorgabe-id (cdr (assoc (cdr (assoc 5 (entget sent))) *cs-sep-fix-by-handle*)))
(setq vorgabe-rec (cs-carrier-by-id vorgabe-id carriers))
(if vorgabe-rec
(setq mode 'vorgabe rec vorgabe-rec)
(progn
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res)
best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
(cond
((eq mode 'none)
(setq n-scan-unassigned (1+ n-scan-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq scanCounts (cs-bump scanCounts (car rec)))
;; Abweichende gespeicherte ZUORDNUNG als Korrektur vermerken,
;; bevor sie unten ueberschrieben wird (Selbstheilung eingefrorener
;; oder verwaister Zuordnungen).
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and alt (/= alt "") (/= alt (nth 9 rec)))
(setq *cs-korrekturen*
(cons (list "Scanner" (cs-get-att-str sent "ID") alt (nth 9 rec))
*cs-korrekturen*)))
(if (member mode '(bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
(if (eq mode 'distance)
(progn
(setq scanner-id (cs-get-att-str sent "ID"))
(setq contested (and second-rec
(<= (- second-d best-d) (cs-strittig-diff-mm))))
(setq *cs-scanner-ergaenzt*
(cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
contested
(if contested (nth 9 second-rec) nil)
(if contested (fix (+ second-d 0.5)) nil))
*cs-scanner-ergaenzt*))
(if contested
(progn
(setq n-strittig (1+ n-strittig))
(setq handle (cdr (assoc 5 (entget sent))))
(setq *cs-scanner-warnung-by-handle*
(cons (cons handle
(strcat "Distanz-Zuordnung unsicher: "
(nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
(nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
*cs-scanner-warnung-by-handle*))
)
)
)
)
)
)
(setq mode (nth 0 res) rec (nth 1 res))
)
(setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))
;; --- Separatoren zuordnen (gleiche Logik, ohne Strittig-Report -
;; der Distanz-Fallback stellt hier nur sicher, dass die
;; ANZAHL_SEPARATOR-Summe auch bei Sonderfaellen stimmt). ---
(foreach s seplist
(setq sent (car s) spt (cadr s))
;; Festgenagelte Zuordnung (verpackter Separator, Carrier bekannt -
;; siehe *cs-sep-fix-by-handle*) hat Vorrang vor der Geometrie. Nur
;; wenn der genannte Carrier gar nicht (mehr) existiert, wird
;; geometrisch zugeordnet.
(setq vorgabe-id (cdr (assoc (cdr (assoc 5 (entget sent))) *cs-sep-fix-by-handle*)))
(setq vorgabe-rec (cs-carrier-by-id vorgabe-id carriers))
(if vorgabe-rec
(setq mode 'vorgabe rec vorgabe-rec)
(progn
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res))
)
)
(cond
((eq mode 'none)
(setq n-sep-unassigned (1+ n-sep-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq sepCounts (cs-bump sepCounts (car rec)))
;; Abweichung nur bei geometrischer Zuordnung als Korrektur melden -
;; bei mode 'vorgabe ist der geschriebene Wert die Vorgabe selbst,
;; keine Korrektur einer Fehl-Zuordnung.
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and (not (eq mode 'vorgabe)) alt (/= alt "") (/= alt (nth 9 rec)))
(setq *cs-korrekturen*
(cons (list "Separator" (cs-get-att-str sent "ID") alt (nth 9 rec))
*cs-korrekturen*)))
(if (member mode '(vorgabe bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
)
)
)
(cond
((eq mode 'none)
(setq n-sep-unassigned (1+ n-sep-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq sepCounts (cs-bump sepCounts (car rec)))
(if (not (eq mode 'vorgabe))
(cs-korrektur-vermerken sent "Separator" (nth 9 rec)))
(if (member mode '(vorgabe bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
)
)
)
(list sepCounts n-sep-unassigned n-zuordnung-fehlt)
)
;; --- ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben ---
(foreach rec carriers
(setq en (car rec))
(setq nm2 (cdr (assoc 2 (entget en))))
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
(setq newS ns)
;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
;; Symbole (Separator_SP/S-LP), die diesem Carrier zugeordnet sind.
;; Der intern in der GF/VF-Kette gezeichnete 300-mm-Block
;; Staustrecke_Separator_SP ist nur ein Kettenglied (Foerder-/
;; Uebergabestueck), KEIN eigenstaendiger Separator - er wird bewusst
;; NICHT mitgezaehlt (Entscheidung: nur platzierte Symbole zaehlen).
(setq newP nsep)
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
(if verbose
(princ (ssg-textf "sens-carrier-zeile"
(list nm2 (nth 9 rec) (itoa newS) (itoa newP)))))
(if (not (and okS okP))
(princ (ssg-textf "sens-carrier-fehler" (list nm2))))
;;; ------------------------------------------------------------
;;; ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben.
;;; scanCounts/sepCounts = Assoc-Listen (carrier-ename . anzahl).
;;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
;;; Symbole (Separator_SP/S-LP); der intern in der GF/VF-Kette
;;; gezeichnete 300-mm-Block Staustrecke_Separator_SP ist nur ein
;;; Kettenglied und wird bewusst NICHT mitgezaehlt.
;;; verbose = T -> je Carrier eine Detailzeile ausgeben.
;;; ------------------------------------------------------------
(defun cs-anzahl-schreiben (carriers scanCounts sepCounts verbose /
rec en nm2 ns nsep okS okP)
(foreach rec carriers
(setq en (car rec))
(setq nm2 (cdr (assoc 2 (entget en))))
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
(setq okS (cs-set-att en (nth 1 rec) (itoa ns)))
(setq okP (cs-set-att en (nth 2 rec) (itoa nsep)))
(if verbose
(princ (ssg-textf "sens-carrier-zeile"
(list nm2 (nth 9 rec) (itoa ns) (itoa nsep)))))
(if (not (and okS okP))
(princ (ssg-textf "sens-carrier-fehler" (list nm2))))
)
)
;;; ------------------------------------------------------------
;;; Abschliessende Konsolen-Zusammenfassung ausgeben: Gesamtzahlen,
;;; per Distanz ergaenzte Scanner (*cs-scanner-ergaenzt*), strittige
;;; Zuordnungen, korrigierte ZUORDNUNGen (*cs-korrekturen*) sowie
;;; markierte unzuordenbare und fehlgeschlagene Attributschreibungen.
;;; ------------------------------------------------------------
(defun cs-bericht-ausgeben (label n-carrier n-scan n-scan-unassigned
n-sep n-sep-unassigned n-strittig
n-zuordnung-fehlt / eintrag)
(princ (ssg-textf "sens-summary"
(list label (itoa n-carrier)
(itoa n-scan) (itoa n-scan-unassigned)
(itoa n-sep) (itoa n-sep-unassigned))))
(if *cs-scanner-ergaenzt*
(progn
(princ (ssg-textf "sens-ergaenzt-header"
(list label (itoa (length *cs-scanner-ergaenzt*)))))
(foreach eintrag *cs-scanner-ergaenzt*
(princ (ssg-textf "sens-ergaenzt-zeile"
(list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
(if (nth 3 eintrag)
(princ (ssg-textf "sens-strittig-suffix"
(list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
)
)
)
(if (> n-strittig 0)
(princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))
;; --- Zusammenfassung ---
(princ (ssg-textf "sens-summary"
(list label (itoa (length carriers))
(itoa (length scanlist)) (itoa n-scan-unassigned)
(itoa (length seplist)) (itoa n-sep-unassigned))))
;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
(if *cs-korrekturen*
(progn
(setq *cs-korrekturen* (reverse *cs-korrekturen*))
(princ (ssg-textf "sens-korrektur-header"
(list label (itoa (length *cs-korrekturen*)))))
(foreach eintrag *cs-korrekturen*
(princ (ssg-textf "sens-korrektur-zeile"
(list (nth 0 eintrag) (nth 1 eintrag)
(nth 2 eintrag) (nth 3 eintrag)))))
)
)
(if *cs-scanner-ergaenzt*
(progn
(princ (ssg-textf "sens-ergaenzt-header"
(list label (itoa (length *cs-scanner-ergaenzt*)))))
(foreach eintrag *cs-scanner-ergaenzt*
(princ (ssg-textf "sens-ergaenzt-zeile"
(list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
(if (nth 3 eintrag)
(princ (ssg-textf "sens-strittig-suffix"
(list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
)
)
)
(if (> n-strittig 0)
(princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
(princ (ssg-textf "sens-unassigned-marked"
(list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
(if (> n-zuordnung-fehlt 0)
(princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
)
;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
(if *cs-korrekturen*
(progn
(setq *cs-korrekturen* (reverse *cs-korrekturen*))
(princ (ssg-textf "sens-korrektur-header"
(list label (itoa (length *cs-korrekturen*)))))
(foreach eintrag *cs-korrekturen*
(princ (ssg-textf "sens-korrektur-zeile"
(list (nth 0 eintrag) (nth 1 eintrag)
(nth 2 eintrag) (nth 3 eintrag)))))
)
)
;;; ============================================================
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
;;; csv:run-export).
;;;
;;; label = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
;;; (nur fuer den interaktiven Befehl sinnvoll - der
;;; automatische Aufruf aus csv:run-export laesst dies aus,
;;; damit die Export-Konsole kompakt bleibt).
;;;
;;; Setzt als Nebenwirkung:
;;; *cs-scanner-ergaenzt* - Liste (scanner-id carrier-id
;;; distanz-mm strittig-p
;;; zweiter-carrier-id zweite-distanz-mm)
;;; je per Abstand (nicht per BBox)
;;; zugeordnetem Scanner.
;;; *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
;;; fuer strittige Scanner-Zuordnungen,
;;; von csv:block-to-json ausgelesen.
;;; *cs-korrekturen* - Liste (typ-wort sensor-id alt-id
;;; neu-id) je Sensor, dessen gespeicherte
;;; ZUORDNUNG nicht zur Geometrie passte
;;; und ueberschrieben wurde (Report).
;;; ============================================================
(defun cs-zuordnung-lauf (label verbose /
mss bloecke carriers scanlist seplist grid
scan-res sep-res scanCounts sepCounts
n-scan-unassigned n-sep-unassigned
n-strittig n-zuordnung-fehlt)
(setq *cs-scanner-ergaenzt* nil)
(setq *cs-scanner-warnung-by-handle* nil)
(setq *cs-korrekturen* nil)
(setq *senstol* (cs-senstol))
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
(princ (ssg-textf "sens-unassigned-marked"
(list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
(if (> n-zuordnung-fehlt 0)
(princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
;; Carrier bekommen haben oder umgekehrt).
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
(if mss (command "_.ERASE" mss ""))
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
(princ (ssg-textf "sens-start" (list label)))
;; INSERTs in Carrier/Scanner/Separator einsortieren.
(setq bloecke (cs-sammle-bloecke))
(setq carriers (nth 0 bloecke)
scanlist (nth 1 bloecke)
seplist (nth 2 bloecke))
(if (and (null carriers) (null scanlist) (null seplist))
(princ (ssg-textf "sens-no-inserts" (list label)))
(progn
(setq grid (cs-grid-build carriers))
;; Scanner zuordnen (BBox, sonst naechster Carrier; Distanz-Fallback
;; + Strittig-Report). Zaehler kommen als Liste zurueck.
(setq scan-res (cs-scanner-zuordnen scanlist carriers grid))
(setq scanCounts (nth 0 scan-res)
n-scan-unassigned (nth 1 scan-res)
n-strittig (nth 2 scan-res)
n-zuordnung-fehlt (nth 3 scan-res))
;; Separatoren zuordnen (Vorgabe hat Vorrang vor der Geometrie).
(setq sep-res (cs-separatoren-zuordnen seplist carriers grid))
(setq sepCounts (nth 0 sep-res)
n-sep-unassigned (nth 1 sep-res)
n-zuordnung-fehlt (+ n-zuordnung-fehlt (nth 2 sep-res)))
;; ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben und Bericht.
(cs-anzahl-schreiben carriers scanCounts sepCounts verbose)
(cs-bericht-ausgeben label (length carriers)
(length scanlist) n-scan-unassigned
(length seplist) n-sep-unassigned
n-strittig n-zuordnung-fehlt)
)
)
(princ)
Lisp/ssg_load.lsp
+1 -2
View File
@@ -35,12 +35,11 @@
(load (strcat base-path "VarioFoerderer.lsp") "VarioFoerderer.lsp nicht gefunden")
(load (strcat base-path "Gefaellestrecke.lsp") "Gefaellestrecke.lsp nicht gefunden")
(load (strcat base-path "export.lsp") "export.lsp nicht gefunden")
(load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden")
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "Tro_Edit.lsp") "Tro_Edit.lsp nicht gefunden")
(load (strcat base-path "Connection_Edit.lsp") "Connection_Edit.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, OmniModulInsert, SSG_LIB_Commands")
(princ)
)
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")