diff --git a/Lisp/ssg_dbg.lsp b/Lisp/ssg_dbg.lsp index 178fd1a..70bb309 100644 --- a/Lisp/ssg_dbg.lsp +++ b/Lisp/ssg_dbg.lsp @@ -90,8 +90,16 @@ ;; (Daten lesen / Dialogaufbau), siehe kf-zeit in ;; KettenFoerderer.lsp. Standard 0 - nur einschalten, ;; wenn der Dialog spuerbar verzoegert erscheint. +;; testlauf - Laufprotokoll je Test von SSG_RUN_ALL_TESTS nach +;; DXFM_LOG/testlauf_.dbg (eigene Datei, nicht +;; ueber *dbg-path*; jede Zeile sofort geschrieben, +;; damit bei einem haengenden Test der letzte Schritt +;; sichtbar ist). Standard 1 - kostet nur ein paar +;; Zeilen je Test, siehe testrun:log in +;; tests/test_run_all.lsp. ;; ------------------------------------------------------------ -(foreach nm '(("vf-sepliste" . 1) ("csv_leave_proxies" . 0) ("kf-zeit" . 0)) +(foreach nm '(("vf-sepliste" . 1) ("csv_leave_proxies" . 0) ("kf-zeit" . 0) + ("testlauf" . 1)) (if (not (assoc (car nm) *dbg-schalter*)) (setq *dbg-schalter* (cons nm *dbg-schalter*)))) diff --git a/Lisp/vf_spec.lsp b/Lisp/vf_spec.lsp index d24a2bb..c053280 100644 --- a/Lisp/vf_spec.lsp +++ b/Lisp/vf_spec.lsp @@ -681,6 +681,7 @@ (setq *vsp-alt-headless* (if (boundp '*vfl-headless*) *vfl-headless*)) (setq *vfl-wizard-mode* nil) (setq *vfl-headless* T) + (setq *vsp-alt-gui* (if (boundp '*ssg-gui-aus*) *ssg-gui-aus*)) (if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus)) (setq *vsp-prompts* 0) (princ)) @@ -693,7 +694,9 @@ alert *vsp-alt-alert*) (setq *vfl-wizard-mode* *vsp-alt-wizard*) (setq *vfl-headless* *vsp-alt-headless*) - (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an)) + ;; Vorzustand zurueck statt pauschal ssg-gui-an: unter SSG_RUN_ALL_TESTS + ;; muss die GUI fuer den Export danach aus bleiben. + (setq *ssg-gui-aus* *vsp-alt-gui*) (princ)) diff --git a/tests/test_hm_recformat.lsp b/tests/test_hm_recformat.lsp index 84a23bf..d5d96a0 100644 --- a/tests/test_hm_recformat.lsp +++ b/tests/test_hm_recformat.lsp @@ -477,6 +477,7 @@ ;; aufgehen und warten). (setq *hmrec-alt-wizard* (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*)) (setq *vfl-wizard-mode* nil) + (setq *hmrec-alt-gui* (if (boundp '*ssg-gui-aus*) *ssg-gui-aus*)) (if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus)) ;; Headless-Riegel der Produktion einschalten: eine erschoepfte Replay-Queue ;; ist dann ein harter, lokalisierter Abbruch statt eines stillen Rueckfalls @@ -497,7 +498,7 @@ alert *hmrec-alt-alert*) (setq *vfl-wizard-mode* *hmrec-alt-wizard*) (setq *vfl-headless* *hmrec-alt-headless*) - (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an)) + (setq *ssg-gui-aus* *hmrec-alt-gui*) ; Vorzustand, nicht pauschal an (princ) ) diff --git a/tests/test_linienzug.lsp b/tests/test_linienzug.lsp index 1b4f820..1752dbd 100644 --- a/tests/test_linienzug.lsp +++ b/tests/test_linienzug.lsp @@ -148,7 +148,7 @@ ;; ebenfalls nur einen einzigen Testfall pro Lauf kennt). (defun tlz-run-datei (json-datei test-id befehl-anzeige / daten meta schritte-anz rest-anz status - old-vgp old-gs old-gi old-gr err) + old-vgp old-gs old-gi old-gr err old-gui) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) (if (null (car (atoms-family 1 '("VF-LINIENZUG-MODUS")))) (progn @@ -185,6 +185,7 @@ ;; GUI aus: keine Wizard-DCL-Dialoge waehrend des automatischen Replays - ;; die Eingaben kommen aus der Mock-Queue (getstring/getint/getreal), siehe ;; ssg-gui-aus/ssg-gui-p in ssg_core.lsp und vfl-wizard-mode-p. + (setq old-gui (if (boundp '*ssg-gui-aus*) *ssg-gui-aus*)) (if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus)) ;; --- Eingabe-Funktionen sichern und durch Mocks ersetzen --- @@ -201,9 +202,11 @@ ;; --- Eingabe-Funktionen wiederherstellen (IMMER) --- (setq vfl-getpoint old-vgp getstring old-gs getint old-gi getreal old-gr) - ;; GUI wieder einschalten (auch nach Fehler), damit eine folgende interaktive - ;; Sitzung nicht headless bleibt. - (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an)) + ;; GUI-Zustand von VOR dem Test wiederherstellen (auch nach Fehler) - NICHT + ;; pauschal einschalten: unter SSG_RUN_ALL_TESTS ist sie fuer den ganzen + ;; Batch aus, und ein pauschales ssg-gui-an liess den anschliessenden + ;; EXPORTSIVAS nach Hoehen-Check/Bereinigen fragen (Lauf hing). + (setq *ssg-gui-aus* old-gui) (setq rest-anz (length *tlz-q*)) diff --git a/tests/test_run_all.lsp b/tests/test_run_all.lsp index 8512036..80d244e 100644 --- a/tests/test_run_all.lsp +++ b/tests/test_run_all.lsp @@ -69,6 +69,45 @@ ;; --- 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). +;; ------------------------------------------------------------ +;; Laufprotokoll je Test (Debug-Schalter "testlauf", Standard EIN) +;; ------------------------------------------------------------ +;; DXFM_LOG/testlauf_.dbg - eine Datei je Test, bei jedem Lauf neu. +;; Bewusst NICHT ueber dbgopen/*dbg-path*: die getesteten Module oeffnen und +;; schliessen dort ihre eigenen .dbg-Dateien (vfl_modus1.dbg ...) und wuerden +;; das Protokoll mitten im Test umlenken. Jede Zeile wird SOFORT angehaengt +;; (kein Puffer) - haengt ein Test, steht der letzte erreichte Schritt drin. +(if (not (boundp '*testrun-log*)) (setq *testrun-log* nil)) + +(defun testrun:log-start (name / dir fh) + (setq *testrun-log* nil) + (if (and (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "testlauf")) + (progn + (setq dir (cond ((getenv "DXFM_LOG")) ((strcat (getenv "DXFMAKRO") "/logs")))) + (vl-mkdir dir) + (setq *testrun-log* (strcat dir "/testlauf_" name ".dbg")) + (if (setq fh (open *testrun-log* "w")) + (progn (write-line (strcat "=== TESTLAUF " name " ===") fh) (close fh)) + (setq *testrun-log* nil)))) + *testrun-log*) + +(defun testrun:log (text / fh) + (if (and *testrun-log* (setq fh (open *testrun-log* "a"))) + (progn + (write-line (strcat (if (car (atoms-family 1 '("DBG-TIMESTAMP"))) (dbg-timestamp) "") + " " text) + fh) + (close fh))) + (princ)) + +;; Schalter, die in einem Testlauf eine Rueckfrage ausloesen koennen. +(defun testrun:zustand () + (strcat "GUI=" (if (and (boundp '*ssg-gui-aus*) *ssg-gui-aus*) "aus" "AN") + " hoehencheck-fragen=" (vl-princ-to-string (if (boundp '*csv-hoehencheck-fragen*) *csv-hoehencheck-fragen*)) + " bereinigen=" (vl-princ-to-string (if (boundp '*csv-bereinigen-vor-export*) *csv-bereinigen-vor-export*)) + " wizard=" (vl-princ-to-string (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*)) + " DWGNAME=" (getvar "DWGNAME"))) + ;; Dateiname ohne fuehrenden Praefix (sonst unveraendert). Gegenstueck zu ;; export:dwg-praefix, den der Export selbst vor den Namen setzt. (defun testrun:ohne-praefix (dateiname praefix) @@ -162,7 +201,7 @@ 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 - praefix) + praefix old-hoehencheck old-bereinigen) (setq tests-pfad (strcat (getenv "DXFMAKRO") "/tests")) (setq tests-out-dir (strcat tests-pfad "/output")) @@ -220,6 +259,13 @@ ;; 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)) + ;; Rueckfragen des Exports (export.lsp) fuer den ganzen Lauf abschalten - + ;; zusaetzlich zur GUI-Sperre, damit auch ein Test, der die GUI wieder + ;; einschaltet, den Export nicht anhalten kann. + (setq old-hoehencheck (if (boundp '*csv-hoehencheck-fragen*) *csv-hoehencheck-fragen*) + old-bereinigen (if (boundp '*csv-bereinigen-vor-export*) *csv-bereinigen-vor-export*)) + (setq *csv-hoehencheck-fragen* nil + *csv-bereinigen-vor-export* 'aus) ;; Tests laden und ausfuehren ;; Jeder Test bekommt eine eigene neue Zeichnung (statt die aktuelle @@ -279,10 +325,18 @@ ;; Testreihenfolge ab und jeder Referenz-Diff wurde unruhig. (setq #VF_LetzteNr 0 #GF_LetzteNr 0 #Kreisel_LetzteNr 0 #Eckrad_LetzteNr 0) + (testrun:log-start name) + (testrun:log (strcat "Test " (itoa idx) "/" (itoa anz) ": " befehl + " Modul=" (if module module "-") + " save=" (if save-fmt save-fmt "-") + " Modus=" (if auto-export "Automatik" "Kontrolle"))) + (testrun:log (strcat "Vor Test: " (testrun:zustand))) + (if (findfile datei) (progn (load datei) ;; Test mit Fehlerbehandlung ausfuehren + (testrun:log (strcat "Starte " befehl)) (setq test-result (vl-catch-all-apply '(lambda () @@ -292,12 +346,18 @@ ) ) (if (vl-catch-all-error-p test-result) - (princ (strcat "\n FEHLER in " befehl ": " - (vl-catch-all-error-message test-result))) - ) + (progn + (princ (strcat "\n FEHLER in " befehl ": " + (vl-catch-all-error-message test-result))) + (testrun:log (strcat "FEHLER in " befehl ": " + (vl-catch-all-error-message test-result)))) + (testrun:log (strcat befehl " beendet"))) + (testrun:log (strcat "Nach Test: " (testrun:zustand))) ;; JSON-Export (immer) (apply export-fn (list tests-out-dir)) + (testrun:log (strcat "Ergebnis-JSON " name "_results.json: " + (if (findfile old-json) "vorhanden" "FEHLT"))) (setq out-path (strcat tests-out-dir "/" name "_tests")) @@ -364,22 +424,40 @@ (T p))) old-filenames)) + ;; Unmittelbar vor dem Export erneut erzwingen: export.lsp setzt + ;; *csv-hoehencheck-fragen* beim (Nach-)Laden von nil auf T, und + ;; ein Test kann die GUI wieder eingeschaltet haben. + (if (not (and (boundp '*ssg-gui-aus*) *ssg-gui-aus*)) + (progn + (testrun:log "WARNUNG: GUI war nach dem Test wieder AN - fuer den Export abgeschaltet") + (princ "\n WARNUNG: GUI war nach dem Test wieder an - abgeschaltet.") + (ssg-gui-aus))) + (setq *csv-hoehencheck-fragen* nil + *csv-bereinigen-vor-export* 'aus) + (testrun:log (strcat "Vor Export: " (testrun:zustand))) + (princ (strcat "\n CSV-Export -> " csv-name)) + (testrun:log (strcat "EXPORTCSV -> " csv-pfad)) (c:EXPORTCSV) (setq csv-ok (testrun:wait-for-file csv-pfad 30.0)) (princ (if csv-ok "\n CSV OK" "\n CSV TIMEOUT/FEHLER")) + (testrun:log (if csv-ok "EXPORTCSV OK" "EXPORTCSV TIMEOUT/FEHLER - Datei nicht entstanden")) (princ (strcat "\n Sivas-Export -> " sivas-name)) + (testrun:log (strcat "EXPORTSIVAS -> " sivas-pfad)) (c:EXPORTSIVAS) (setq sivas-ok (testrun:wait-for-file sivas-pfad 30.0)) (princ (if sivas-ok "\n Sivas OK" "\n Sivas TIMEOUT/FEHLER")) + (testrun:log (if sivas-ok "EXPORTSIVAS OK" "EXPORTSIVAS TIMEOUT/FEHLER - Datei nicht entstanden")) (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. + (testrun:log "Zeichnung schliessen") (vla-close new-doc :vlax-false) + (testrun:log "Test fertig") ) ;; ========================================================== @@ -441,7 +519,9 @@ ) ) ) - (princ (strcat "\n WARNUNG: " datei " nicht gefunden - uebersprungen")) + (progn + (princ (strcat "\n WARNUNG: " datei " nicht gefunden - uebersprungen")) + (testrun:log (strcat "WARNUNG: " datei " nicht gefunden - uebersprungen"))) ) ) ;; end (progn ...) des aktiven Zweigs ) ;; end (if (cdr (assoc "disabled" entry)) ...) @@ -449,6 +529,10 @@ ;; GUI wieder einschalten (Batch fertig). (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an)) + ;; nil = "nie gesetzt" (export.lsp belegt dann mit der Vorgabe vor) + (setq *csv-hoehencheck-fragen* (if old-hoehencheck old-hoehencheck T) + *csv-bereinigen-vor-export* (if old-bereinigen old-bereinigen 'an)) + (setq *testrun-log* nil) (setq *export-test-override* nil)