381 lines
15 KiB
Common Lisp
381 lines
15 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). SSG_RUN_ALL_TESTS fragt zu
|
|
;; Beginn interaktiv nach dem gewuenschten Modus:
|
|
;; 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).
|
|
;; 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)
|
|
(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"))
|
|
(if name
|
|
(setq ergebnis (cons
|
|
(list (cons "name" name) (cons "save" save-fmt) (cons "module" module))
|
|
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)
|
|
|
|
(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 abfragen: Kontrolle (Zeichnungen bleiben offen, kein Export)
|
|
;; oder Automatik (Speichern + CSV/Sivas-Export + Schliessen je Test).
|
|
;; ssg-ques gibt T zurueck wenn "No" gewaehlt wurde - deshalb "not".
|
|
;; Default = Nein -> Kontroll-Modus (nicht-destruktiver Default).
|
|
(setq auto-export
|
|
(not (ssg-ques
|
|
"Zeichnungen automatisch speichern, exportieren (CSV/Sivas) und schliessen"
|
|
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================================================================")
|
|
|
|
;; 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)))
|
|
|
|
;; 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"))
|
|
(command "_.DXFOUT" out-path 6)
|
|
(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)
|
|
(command "_.DXFOUT" out-path 6)
|
|
(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"))
|
|
)
|
|
)
|
|
|
|
(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)
|
|
)
|