Files
dxfmakros/tests/test_run_all.lsp
T
m.stangl 3698c8982c Sepliste-XDATA fuer Separator/AS/ES-Reihenfolge + Unit-Tests, makunbound-Fix
Sammelt beim Bau von VF_n/GF_n-Ketten die Baureihenfolge der Separator-/
AS-/ES-Sub-Bloecke vor dem Block-Sweep und schreibt sie als XDATA auf den
fertigen Wrapper (ssg_ks_insert.lsp); export.lsp liest sie fuer das neue
"sepliste"-Feld im CSV-Export, export_neighbors.py nutzt es als Fallback
zur BBox-Kollisionspruefung. Dazu Unit-Tests fuer die reinen Serialisierungs-
funktionen (Chunking, Roundtrip) in test_unit.lsp.

Ausserdem: makunbound (existiert nicht in BricsCAD-AutoLISP) aus
test_run_all.lsp entfernt - verursachte Laufzeitfehler bei
SSG_RUN_ALL_TESTS_EXPORT/_OFFEN.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-09 20:36:42 +02:00

437 lines
18 KiB
Common Lisp

;; ============================================================
;; test_run_all.lsp - Fuehrt alle LISP-Tests nacheinander aus
;;
;; Laedt und startet alle in tests/alltests.json registrierten Tests.
;; Konvention: Aus Basisname <name> leiten sich ab:
;; Datei: test_<name>.lsp
;; Befehl: TEST_<NAME>
;; Export: <name>:export-results
;;
;; Ergebnisse werden in tests/output/ gespeichert:
;; JSON: immer (<name>_results.json, via <name>:export-results)
;; DXF: wenn "save": "dxf" in alltests.json
;; DWG: wenn "save": "dwg" in alltests.json
;; keins: wenn "save" fehlt, null oder leer
;;
;; Voraussetzungen:
;; - SSG_LIB geladen
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_run_all.lsp"))
;; SSG_RUN_ALL_TESTS
;;
;; Jedes Testmodul laeuft in einer eigenen, neuen Zeichnung (statt die
;; aktuelle zu leeren/wiederzuverwenden). Der Modus wird ueber den
;; aufgerufenen Befehl bestimmt (keine interaktive Rueckfrage):
;; SSG_RUN_ALL_TESTS_OFFEN / SSG_RUN_ALL_TESTS (Kontroll-Modus, Default):
;; Zeichnung wird gespeichert, auf den Inhalt gezoomt und bleibt als
;; Tab offen - kein CSV/Sivas-Export. Am Ende sind alle Testzeichnungen
;; gleichzeitig offen und koennen direkt begutachtet werden. CSV/Sivas-
;; Export danach bei Bedarf manuell ueber TEST_EXPORT_ALL
;; (tests/test_export_all.lsp).
;; SSG_RUN_ALL_TESTS_EXPORT (Automatik-Modus): Zeichnung wird gespeichert,
;; per EXPORTCSV/EXPORTSIVAS exportiert und danach sofort wieder
;; geschlossen - kompletter Lauf ohne manuellen Zusatzschritt, aber
;; ohne gleichzeitige visuelle Kontrolle aller Zeichnungen am Ende.
;; ============================================================
(vl-load-com)
;; --- Auf Fertigstellung einer asynchron geschriebenen Datei warten ---
;; csv:run-export startet Python per startapp (fire-and-forget). Pollt
;; bis die Datei existiert und ihre Groesse ueber ein Intervall stabil
;; bleibt, oder bis timeout-sec erreicht ist. Rueckgabe: T bei Erfolg.
;; (Analog zu export_all:wait-for-file aus tests/test_export_all.lsp,
;; hier lokal, da hier direkt auf der offenen Zeichnung exportiert wird
;; statt auf einer bereits gespeicherten Datei.)
(defun testrun:wait-for-file (path timeout-sec / elapsed size1 size2 done)
(setq elapsed 0.0 done nil)
(while (and (not done) (< elapsed timeout-sec))
(if (findfile path)
(progn
(setq size1 (vl-file-size path))
(command "_.DELAY" 400)
(setq size2 (vl-file-size path))
(if (and size1 size2 (= size1 size2) (> size1 0))
(setq done T)
)
)
(command "_.DELAY" 400)
)
(setq elapsed (+ elapsed 0.4))
)
done
)
;; --- Hilfsfunktion: String-Wert aus JSON-Objekt-Zeile lesen ---
;; Sucht "key": "value" in obj-str und gibt value zurueck.
;; Rueckgabe: String (nicht leer) oder nil (key fehlt, null, leer).
(defun alltests:get-str (obj-str key / pat pos val-start val-end val)
(setq pat (strcat "\"" key "\": \""))
(setq pos (vl-string-search pat obj-str))
(if pos
(progn
(setq val-start (+ pos (strlen pat))) ;; 0-basiert
(setq val-end (vl-string-search "\"" obj-str val-start))
(if val-end
(progn
(setq val (substr obj-str (1+ val-start) (- val-end val-start)))
(if (> (strlen val) 0) val nil)
)
)
)
)
)
;; --- Testliste aus tests/alltests.json laden ---
;; Erwartet ein JSON-Array, je Zeile ein Objekt: { "name": "...", "save": "..." }
;; "save" kann "dxf", "dwg", null oder fehlen (= kein Speichern).
;; Rueckgabe: Liste von Assoc-Listen (("name" . "kreisel") ("save" . "dxf"))
(defun alltests:load (tests-pfad / json-datei f zeile ergebnis name save-fmt module disabled)
(setq json-datei (strcat tests-pfad "/alltests.json"))
(if (not (findfile json-datei))
(progn
(princ (strcat "\n FEHLER: " json-datei " nicht gefunden!"))
nil
)
(progn
(setq f (open json-datei "r"))
(if (null f)
(progn
(princ (strcat "\n FEHLER: Kann " json-datei " nicht oeffnen!"))
nil
)
(progn
(setq ergebnis nil)
(while (setq zeile (read-line f))
;; Jede Zeile mit "name" ist ein Test-Eintrag (ein Objekt pro Zeile)
(if (vl-string-search "\"name\"" zeile)
(progn
(setq name (alltests:get-str zeile "name"))
(setq save-fmt (alltests:get-str zeile "save"))
(setq module (alltests:get-str zeile "module"))
;; "disabled": true schaltet einen Test-Eintrag ab (JSON-Boolean,
;; daher direkte Textsuche statt alltests:get-str fuer Strings).
(setq disabled (if (vl-string-search "\"disabled\": true" zeile) "1" nil))
(if name
(setq ergebnis (cons
(list (cons "name" name) (cons "save" save-fmt)
(cons "module" module) (cons "disabled" disabled))
ergebnis))
)
)
)
)
(close f)
(reverse ergebnis)
)
)
)
)
)
;; --- Konventionsbasierte Namen aus Basisname ableiten ---
;; Gibt Assoc-Liste zurueck: datei, befehl, export-fn
(defun test-module-names (name tests-pfad)
(list
(cons "datei" (strcat tests-pfad "/test_" name ".lsp"))
(cons "befehl" (strcat "TEST_" (strcase name)))
(cons "export-fn" (read (strcat name ":export-results")))
)
)
(defun c:SSG_RUN_ALL_TESTS ( / tests-pfad tests-out-dir app auto-export
idx anz entry name save-fmt module
namen befehl datei export-fn new-doc
out-path dwg-pfad dxf-pfad old-json test-result
old-filenames csv-name sivas-name csv-pfad
sivas-pfad csv-ok sivas-ok old-filedia)
(setq tests-pfad (strcat (getenv "DXFMAKRO") "/tests"))
(setq tests-out-dir (strcat tests-pfad "/output"))
(vl-mkdir tests-out-dir)
(setq app (vlax-get-acad-object))
;; Testliste aus alltests.json laden
(setq *test-module* (alltests:load tests-pfad))
(if (null *test-module*)
(progn
(princ "\n FEHLER: Keine Test-Module geladen. Abbruch.")
(exit)
)
)
(setq anz (length *test-module*))
(setq idx 0)
;; Modus bestimmen: Kontrolle (Zeichnungen bleiben offen, kein Export)
;; oder Automatik (Speichern + CSV/Sivas-Export + Schliessen je Test).
;; Die Wahl kommt ueber die Menue-Befehle SSG_RUN_ALL_TESTS_EXPORT
;; (Automatik) bzw. SSG_RUN_ALL_TESTS_OFFEN (Kontrolle), die
;; *ssg-run-all-auto-export* vorbelegen - keine interaktive Rueckfrage.
;; Ein direkter SSG_RUN_ALL_TESTS ohne Vorbelegung faellt auf den
;; nicht-destruktiven Kontroll-Modus (nil) zurueck.
(if (boundp '*ssg-run-all-auto-export*)
(progn
(setq auto-export *ssg-run-all-auto-export*)
(setq *ssg-run-all-auto-export* nil) ;; Vorauswahl nur einmal gueltig
)
(setq auto-export nil)
)
(princ "\n")
(princ "\n================================================================")
(princ "\n SSG_RUN_ALL_TESTS")
(princ (strcat "\n " (itoa anz) " Testmodule (aus alltests.json)"))
(princ (if auto-export
"\n Modus: Automatik (speichern + CSV/Sivas-Export + schliessen)"
"\n Modus: Kontrolle (Zeichnungen bleiben offen, kein Export)"
))
(princ "\n================================================================")
;; GUI aus fuer den gesamten Batch: kein Modul (insb. VarioFoerderer-Linienzug)
;; oeffnet DCL-/Wizard-Dialoge, die den automatischen Lauf blockieren wuerden.
;; Am Ende wieder einschalten. Siehe ssg-gui-aus/-an in ssg_core.lsp.
(if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
;; Tests laden und ausfuehren
;; Jeder Test bekommt eine eigene neue Zeichnung (statt die aktuelle
;; zu leeren/wiederzuverwenden) und bleibt danach als Tab offen.
(foreach entry *test-module*
(setq idx (1+ idx))
(setq name (cdr (assoc "name" entry)))
(setq save-fmt (cdr (assoc "save" entry)))
(setq module (cdr (assoc "module" entry)))
(if (cdr (assoc "disabled" entry))
;; Test in alltests.json per "disabled": true abgeschaltet - ueberspringen,
;; nichts bauen/speichern/exportieren, nur Hinweis ausgeben.
(princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " name
" <<< [DEAKTIVIERT in alltests.json - uebersprungen]"))
(progn
;; Namen aus Konvention ableiten
(setq namen (test-module-names name tests-pfad))
(setq datei (cdr (assoc "datei" namen)))
(setq befehl (cdr (assoc "befehl" namen)))
(setq export-fn (cdr (assoc "export-fn" namen)))
;; Benoetigtes LISP-Modul laden (falls noch nicht geschehen)
(if module
(ssg-ensure module)
)
;; Alte Ergebnis-JSON loeschen: fehlgeschlagene Tests sind am Fehlen der Datei erkennbar
(setq old-json (strcat tests-out-dir "/" name "_results.json"))
(if (findfile old-json)
(vl-file-delete old-json)
)
(princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " befehl " <<<"))
(if save-fmt
(princ (strcat " [save: " save-fmt "]"))
(princ " [kein Speichern]")
)
;; Neue, leere Zeichnung fuer diesen Test anlegen und aktivieren
(setq new-doc (vla-add (vla-get-documents app)))
(vla-put-activedocument app new-doc)
;; vf_core.lsp/Gefaellestrecke.lsp setzen die globalen Variablen "doc"
;; und "modelspace" nur EINMAL, beim ersten Laden des Moduls (Top-Level-
;; Code, kein erneuter Aufruf durch ssg-ensure). Ohne diese Aktualisierung
;; wuerden VarioFoerderer/Gefaellestrecke weiterhin in das allererste
;; Dokument der Sitzung zeichnen statt in die hier neu angelegte
;; Zeichnung - die neuen Tabs blieben leer.
(setq doc new-doc)
(setq modelspace (vla-get-modelspace new-doc))
;; Block-Library-Flag zuruecksetzen (Bloecke sind pro Zeichnung neu zu laden)
(setq *lib-initialized* nil)
(if (findfile datei)
(progn
(load datei)
;; Test mit Fehlerbehandlung ausfuehren
(setq test-result
(vl-catch-all-apply
'(lambda ()
(eval (list (read (strcat "c:" befehl))))
)
nil
)
)
(if (vl-catch-all-error-p test-result)
(princ (strcat "\n FEHLER in " befehl ": "
(vl-catch-all-error-message test-result)))
)
;; JSON-Export (immer)
(apply export-fn (list tests-out-dir))
(setq out-path (strcat tests-out-dir "/" name "_tests"))
(if auto-export
;; ==========================================================
;; AUTOMATIK-MODUS: speichern (vereinfacht, kein Tab-Naming-
;; Trick noetig) + CSV/Sivas-Export + Zeichnung schliessen.
;; ==========================================================
(progn
(cond
((and save-fmt (= (strcase save-fmt) "DWG"))
(setq dwg-pfad (strcat out-path ".dwg"))
(vla-saveas new-doc dwg-pfad)
(princ (strcat "\n DWG gespeichert: " dwg-pfad))
)
((and save-fmt (= (strcase save-fmt) "DXF"))
;; FILEDIA=0 erzwingen: sonst oeffnet "_.DXFOUT" den nativen
;; Speichern-Dialog (blockiert im Skriptlauf) statt die
;; Kommandozeilen-Prompts (Dateiname/Genauigkeit) zu nutzen -
;; das brachte den nachfolgenden vla-close aus dem Takt
;; (siehe Kontroll-Modus-Zweig weiter unten fuer Details).
(setq old-filedia (getvar "FILEDIA"))
(setvar "FILEDIA" 0)
(command "_.DXFOUT" out-path 6)
(setvar "FILEDIA" old-filedia)
(princ (strcat "\n DXF gespeichert: " out-path ".dxf"))
)
(T
(princ "\n (kein Speichern der Zeichnung)")
)
)
;; CSV/Sivas-Export direkt auf der offenen Zeichnung.
;; *export-filenames* temporaer umbiegen, damit jeder Test
;; seine eigenen CSV-Ergebnisse bekommt (statt der fixen
;; Standardnamen "export.csv"/"export_sivas.csv").
(setq csv-name (strcat name "_tests_export.csv"))
(setq sivas-name (strcat name "_tests_sivas.csv"))
(setq csv-pfad (strcat tests-out-dir "/" csv-name))
(setq sivas-pfad (strcat tests-out-dir "/" sivas-name))
(if (findfile csv-pfad) (vl-file-delete csv-pfad))
(if (findfile sivas-pfad) (vl-file-delete sivas-pfad))
(setq old-filenames *export-filenames*)
(setq *export-filenames*
(list
(cons "raw_json_datei" (cdr (assoc "raw_json_datei" old-filenames)))
(cons "sivas_script" (cdr (assoc "sivas_script" old-filenames)))
(cons "sivas_csv" sivas-name)
(cons "csv_script" (cdr (assoc "csv_script" old-filenames)))
(cons "csv_csv" csv-name)
)
)
(princ (strcat "\n CSV-Export -> " csv-name))
(c:EXPORTCSV)
(setq csv-ok (testrun:wait-for-file csv-pfad 30.0))
(princ (if csv-ok "\n CSV OK" "\n CSV TIMEOUT/FEHLER"))
(princ (strcat "\n Sivas-Export -> " sivas-name))
(c:EXPORTSIVAS)
(setq sivas-ok (testrun:wait-for-file sivas-pfad 30.0))
(princ (if sivas-ok "\n Sivas OK" "\n Sivas TIMEOUT/FEHLER"))
(setq *export-filenames* old-filenames)
;; Zeichnung schliessen: der urspruenglich schon offene Tab
;; bleibt unangetastet, BricsCAD erzeugt daher kein neues
;; Blank-Dokument samt Modul-/Menue-Reload.
(vla-close new-doc :vlax-false)
)
;; ==========================================================
;; KONTROLL-MODUS: speichern, auf Inhalt zoomen, Tab offen
;; lassen (bisheriges Verhalten).
;; ==========================================================
(progn
(cond
((and save-fmt (= (strcase save-fmt) "DWG"))
;; Direkt als DWG speichern - Tab bleibt offen und benannt.
;; Ueber ActiveX statt "_.-SAVEAS" "R2013" ...: Das Versions-
;; Keyword "R2013" wird von BricsCADs Kommandozeilen-SAVEAS
;; nicht zuverlaessig erkannt, wodurch der Befehl auf eine
;; ungueltige Eingabe wartet und nie eine Datei schreibt
;; (nachfolgende LISP-Eingaben landen dann im haengenden
;; Prompt). vla-saveas ist deterministisch.
(setq dwg-pfad (strcat out-path ".dwg"))
(vla-saveas new-doc dwg-pfad)
(princ (strcat "\n DWG gespeichert: " dwg-pfad))
)
((and save-fmt (= (strcase save-fmt) "DXF"))
;; Erst als DWG speichern (nur fuer den Tab-Namen) und DXF
;; exportieren. Danach die Zeichnung schliessen (entsperrt die
;; DWG-Datei), die temporaere DWG loeschen und stattdessen die
;; eigentlich angeforderte DXF-Datei erneut oeffnen - der Tab
;; ist dann korrekt an die DXF gebunden, keine ungewollte DWG
;; bleibt liegen.
(setq dwg-pfad (strcat out-path ".dwg"))
(setq dxf-pfad (strcat out-path ".dxf"))
(vla-saveas new-doc dwg-pfad)
;; FILEDIA=0 erzwingen: sonst oeffnet "_.DXFOUT" den nativen
;; Speichern-Dialog statt der Kommandozeilen-Prompts - der
;; Skriptlauf haengt dann in einem offenen Dialog fest, und
;; der nachfolgende vla-close (auf dem noch "belegten"
;; Dokument) bricht mit "bad argument type <0>" ab, weil
;; new-doc dabei ungueltig wird.
(setq old-filedia (getvar "FILEDIA"))
(setvar "FILEDIA" 0)
(command "_.DXFOUT" out-path 6)
(setvar "FILEDIA" old-filedia)
(vla-close new-doc :vlax-false)
(if (findfile dwg-pfad) (vl-file-delete dwg-pfad))
(setq new-doc (vla-open (vla-get-documents app) dxf-pfad))
(vla-put-activedocument app new-doc)
(setq doc new-doc)
(setq modelspace (vla-get-modelspace new-doc))
(princ (strcat "\n DXF gespeichert: " dxf-pfad))
)
(T
;; Kein Speichern angefordert: keine Datei erzeugen, Tab
;; bleibt beim generischen Namen ("ZeichnungN").
(princ "\n (kein Speichern der Zeichnung)")
)
)
;; Ansicht auf den gesamten Inhalt zoomen, Tab bleibt offen
;; (naechster Test startet in einer neuen Zeichnung).
(command "_.ZOOM" "_Extents")
)
)
)
(princ (strcat "\n WARNUNG: " datei " nicht gefunden - uebersprungen"))
)
) ;; end (progn ...) des aktiven Zweigs
) ;; end (if (cdr (assoc "disabled" entry)) ...)
)
;; GUI wieder einschalten (Batch fertig).
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
(princ "\n\n================================================================")
(princ "\n SSG_RUN_ALL_TESTS abgeschlossen.")
(princ (strcat "\n Ergebnisse in: " (getenv "DXFMAKRO") "/tests/output/"))
(if (not auto-export)
(princ "\n CSV/Sivas-Export: TEST_EXPORT_ALL manuell aufrufen (Menue: Tests -> Export CSV/Sivas ALL)")
)
(princ "\n================================================================")
(princ)
)
;; Menue-Wrapper: fester Modus ohne Rueckfrage.
;; _EXPORT = Automatik (speichern + CSV/Sivas-Export + schliessen)
;; _OFFEN = Kontrolle (Zeichnungen bleiben offen, kein Export)
(defun c:SSG_RUN_ALL_TESTS_EXPORT ()
(setq *ssg-run-all-auto-export* T)
(c:SSG_RUN_ALL_TESTS)
)
(defun c:SSG_RUN_ALL_TESTS_OFFEN ()
(setq *ssg-run-all-auto-export* nil)
(c:SSG_RUN_ALL_TESTS)
)