Files
dxfmakros/tests/test_linienzug.lsp
T
m.stangl 9e3e8e16ae fix(tests): Testlauf haengt nicht mehr an Export-Rueckfragen, Laufprotokoll je Test
TEST_LINIENZUG (ebenso hmrec:stubs-aus und vsp-headless-aus) schaltete die
GUI am Ende pauschal wieder ein. Unter SSG_RUN_ALL_TESTS fragte der direkt
folgende EXPORTSIVAS dann nach Hoehen-Check/Bereinigen und der Lauf blieb
stehen. Alle drei stellen jetzt den Vorzustand von *ssg-gui-aus* wieder her.

SSG_RUN_ALL_TESTS schaltet zusaetzlich *csv-hoehencheck-fragen* und
*csv-bereinigen-vor-export* fuer den Lauf ab (unmittelbar vor jedem Export
erneut, export.lsp belegt nil beim Nachladen wieder mit T), erzwingt GUI aus
mit Warnung und stellt am Ende die Vorgaben wieder her.

Neues Laufprotokoll DXFM_LOG/testlauf_<name>.dbg je Test (Debug-Schalter
"testlauf", Standard ein): Zustand vor/nach dem Test, Fehler, Ergebnis-JSON,
Export-Schritte. Eigene Datei mit sofortigem Schreiben statt dbgopen, damit
die Module mit ihren eigenen .dbg-Dateien es nicht umlenken und bei einem
Haenger der letzte Schritt sichtbar ist.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-28 09:52:10 +01:00

413 lines
18 KiB
Common Lisp

;; ============================================================
;; test_linienzug.lsp - Regressionstest fuer den VF-Linienzug (Modus 1)
;;
;; Eigenstaendige Testdatei (getrennt von test_foerderer.lsp).
;;
;; Der VF-Linienzug (vf-linienzug-modus) ist stark interaktiv (getpoint /
;; getstring / getint / getreal). Dieser Test spielt eine reale Session als
;; Skript ab: die vier Eingabe-Funktionen werden NUR waehrend des Testlaufs
;; durch Mocks ersetzt (mit Save/Restore), danach wieder hergestellt.
;;
;; Die Eingabe-Sequenz (Skript) wird NICHT mehr im Code hartkodiert, sondern
;; aus tests/testdata/linienzug_tests.json geladen. Jedes JSON-Objekt mit
;; "typ" ist ein Eingabe-Schritt in exakter Aufruf-Reihenfolge:
;; {"typ":"point_abs","wert":[x,y,z]} absoluter Punkt (getpoint)
;; {"typ":"point_rel","dL":..,"hz":..} Basispunkt + dL entlang Richtung hz
;; {"typ":"point_none"} getpoint ohne Punkt (Enter -> nil)
;; {"typ":"real","wert":..} getreal
;; {"typ":"int","wert":..} getint
;; {"typ":"string","wert":".."} getstring
;; Das erste Objekt (ohne "typ") enthaelt Beschreibung/Erwartung (Metadaten).
;;
;; Voraussetzungen:
;; - SSG_LIB geladen (VarioFoerderer.lsp inkl. vf_linienzug.lsp mit
;; vfl-getpoint, Gefaellestrecke.lsp, ssg_core.lsp)
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Speichert (Konvention fuer test_run_all.lsp):
;; - tests/output/linienzug_results.json (via linienzug:export-results)
;;
;; Erwartetes Ergebnis (Ist-Ziel-Report, siehe Metadaten in JSON):
;; dX ~ 0, dZ ~ 0 (Ziel exakt getroffen),
;; dY ~ 637 mm = seitlicher Fussabdruck des ES_Element_90 (90-Grad-Schwenk;
;; KEIN Baufehler, sondern die Bauform des ES-Elements).
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_linienzug.lsp"))
;; TEST_LINIENZUG (Standard-Szenario, linienzug_tests.json, in
;; alltests.json/SSG_RUN_ALL_TESTS registriert)
;; TEST_LINIENZUG_STUFE2 (Stufe-2-Fallback-Regressionstest Kettenende,
;; linienzug_tests_stufe2.json, manueller Aufruf)
;; ============================================================
;; Naechste Skript-Antwort liefern (FIFO). Bei leerer Queue Warnung + "".
(defun tlz-pop ( / v)
(if *tlz-q*
(progn (setq v (car *tlz-q*)) (setq *tlz-q* (cdr *tlz-q*)) v)
(progn (princ "\n [TEST_LINIENZUG] WARNUNG: Skript-Queue leer - unerwartete Abfrage!") "")
)
)
;; Mock-Eingabefunktionen. getpoint erhaelt als 1. Argument den Basispunkt
;; (p-akt) bei Folge-Segmenten bzw. einen Prompt-String beim Startpunkt.
;; Skript-Eintrag (A x y z) -> absoluter Punkt
;; Skript-Eintrag (P dL hz) -> Basispunkt + dL entlang Richtung hz (Grad),
;; sodass die Projektion in vfl-neue-linie-messen
;; exakt dL ergibt.
;; Skript-Eintrag KEIN -> nil (Enter ohne Punkt, z.B. optionale
;; AS-Zufuehrungsachse nicht gesetzt)
(defun tlz-getpoint (a b / spec base rad)
(setq spec (tlz-pop))
(setq base (if (and a (listp a)) a '(0.0 0.0 0.0)))
(cond
((= spec 'KEIN) nil)
((and (listp spec) (= (car spec) 'A))
(list (float (cadr spec)) (float (caddr spec)) (float (cadddr spec))))
(T
(progn
(setq rad (* (float (caddr spec)) (/ pi 180.0)))
(list (+ (car base) (* (float (cadr spec)) (cos rad)))
(+ (cadr base) (* (float (cadr spec)) (sin rad)))
(caddr base))
)
)
)
)
(defun tlz-getstring (a) (tlz-pop))
(defun tlz-getint (a) (tlz-pop))
(defun tlz-getreal (a) (tlz-pop))
;; --- Parsierte JSON-Daten in die Skript-Queue uebersetzen ---
;; Erwartet die von ssg-load-json gelieferte Liste von Alists.
;; Nur Objekte mit "typ" sind Eingabe-Schritte; Objekte ohne "typ"
;; (Metadaten) werden uebersprungen. Die Reihenfolge bleibt erhalten.
;; Rueckgabe: Queue im Format, das die Mock-Funktionen erwarten.
(defun tlz-daten->queue (daten / q typ)
(setq q nil)
(foreach schritt daten
(setq typ (ssg-val schritt "typ"))
(cond
((= typ "point_abs")
(setq q (cons (cons 'A (ssg-val schritt "wert")) q)))
((= typ "point_rel")
(setq q (cons (list 'P (ssg-val schritt "dL") (ssg-val schritt "hz")) q)))
((= typ "point_none")
(setq q (cons 'KEIN q)))
((= typ "real")
(setq q (cons (float (ssg-val schritt "wert")) q)))
((= typ "int")
(setq q (cons (ssg-val schritt "wert") q)))
((= typ "string")
(setq q (cons (ssg-val schritt "wert") q)))
)
)
(reverse q)
)
;; --- Metadaten-Objekt (Beschreibung/Erwartung) aus JSON-Daten holen ---
;; Liefert die erste Alist ohne "typ" oder nil.
(defun tlz-daten->meta (daten / meta)
(setq meta nil)
(foreach obj daten
(if (and (null meta) (null (ssg-val obj "typ")))
(setq meta obj)
)
)
meta
)
;; --- JSON-Export der Linienzug-Testergebnisse (Konvention fuer run-all) ---
(defun linienzug:export-results (tests-out-dir / out-json f)
(if (null *linienzug-test-results*)
(princ "\n Keine Linienzug-Ergebnisse vorhanden.")
(progn
(vl-mkdir tests-out-dir)
(setq out-json (strcat tests-out-dir "/linienzug_results.json"))
(setq f (open out-json "w"))
(if f
(progn
(write-line "[" f)
(write-line *linienzug-test-results* f)
(write-line "]" f)
(close f)
(princ (strcat "\n Ergebnisse: " out-json))
)
(princ (strcat "\n FEHLER: Kann " out-json " nicht schreiben!"))
)
)
)
)
;; --- Gemeinsamer Replay-Kern, von allen c:TEST_LINIENZUG*-Befehlen genutzt ---
;; befehl-anzeige: nur fuer die Konsolen-Ueberschrift/ssg-start (String).
;; test-id: Bezeichner fuer das *linienzug-test-results*-JSON (run-all-
;; Konvention, siehe linienzug:export-results).
;; Rueckgabe: (status schritte-anz rest-anz) - status ist "OK"/"ABWEICHUNG"/
;; "FEHLER". Setzt zusaetzlich *linienzug-test-results* (letzter Aufruf
;; gewinnt - identisch zum bisherigen Verhalten von c:TEST_LINIENZUG, das
;; 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-gui)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(if (null (car (atoms-family 1 '("VF-LINIENZUG-MODUS"))))
(progn
(alert (strcat "vf-linienzug-modus nicht geladen!\n"
"Bitte Menue/Module laden (VarioFoerderer + Gefaellestrecke)."))
(exit)
)
)
(princ "\n================================================================")
(princ (strcat "\n " befehl-anzeige " - VF-Linienzug Replay-Test"))
(princ "\n================================================================")
;; --- Eingabe-Skript aus JSON laden ---
(setq daten (ssg-load-json json-datei))
(if (null daten)
(progn
(alert (strcat "Testdaten nicht gefunden:\n" json-datei))
(exit)
)
)
(setq meta (tlz-daten->meta daten))
(setq *tlz-q* (tlz-daten->queue daten))
(setq schritte-anz (length *tlz-q*))
(princ (strcat "\n Testdaten: " json-datei))
(princ (strcat "\n Eingabe-Schritte: " (itoa schritte-anz)))
(if meta (princ (strcat "\n Szenario: " (ssg-val meta "beschreibung"))))
(ssg-start befehl-anzeige '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; 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 ---
;; Punkte ueber den Produktions-Wrapper vfl-getpoint (feste 2-Arity),
;; getstring/getint/getreal (alle 1-argumentig) direkt.
(setq old-vgp vfl-getpoint old-gs getstring old-gi getint old-gr getreal)
(setq vfl-getpoint tlz-getpoint
getstring tlz-getstring
getint tlz-getint
getreal tlz-getreal)
;; --- Linienzug-Modus abspielen (Fehler abfangen, damit Restore sicher laeuft) ---
(setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
;; --- Eingabe-Funktionen wiederherstellen (IMMER) ---
(setq vfl-getpoint old-vgp getstring old-gs getint old-gi getreal old-gr)
;; 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*))
(princ "\n================================================================")
(if (vl-catch-all-error-p err)
(progn
(setq status "FEHLER")
(princ (strcat "\n " befehl-anzeige ": FEHLER -> "
(vl-catch-all-error-message err))))
(progn
(setq status (if (= rest-anz 0) "OK" "ABWEICHUNG"))
(princ (strcat "\n " befehl-anzeige ": Kette gebaut."))
(if (> rest-anz 0)
(princ (strcat "\n WARNUNG: " (itoa rest-anz)
" Skript-Eintraege NICHT verbraucht (Ablauf weicht ab)."))
(princ "\n Alle Skript-Eingaben verbraucht (Ablauf wie erwartet)."))
(if meta
(princ (strcat "\n Erwartung Ist-Ziel: dX~"
(itoa (ssg-val meta "erwartung_dx_mm")) ", dZ~"
(itoa (ssg-val meta "erwartung_dz_mm")) ", dY~"
(itoa (ssg-val meta "erwartung_dy_mm")) " mm ("
(ssg-val meta "erwartung_hinweis") ").")))
)
)
(princ "\n================================================================")
;; --- Ergebnis fuer run-all als JSON-String ablegen ---
(setq *linienzug-test-results*
(strcat " {\n"
" \"test_id\": \"" test-id "\",\n"
" \"status\": \"" status "\",\n"
" \"schritte_gesamt\": " (itoa schritte-anz) ",\n"
" \"schritte_offen\": " (itoa rest-anz) "\n"
" }"))
(ssg-end)
(list status schritte-anz rest-anz)
)
(defun c:TEST_LINIENZUG ( / json-datei)
(setq json-datei
(strcat (getenv "DXFMAKRO") "\\tests\\testdata\\linienzug_tests.json"))
(tlz-run-datei json-datei "LZ_Standard" "TEST_LINIENZUG")
(princ)
)
;; Zweiter Testfall (Regressionstest, in dieser Session neu aufgenommen):
;; Stufe-2-Fallback beim Kettenende (typ=VF winkel=0, horizontales VF + GF-
;; Ausgleich), siehe Beschreibung/Kommentare in linienzug_tests_stufe2.json.
;; Eigenstaendiger Befehl statt zweitem Array-Eintrag in linienzug_tests.json,
;; damit LZ_Standard unangetastet bleibt (jede JSON-Datei bleibt ein
;; einzelnes Szenario, wie von tlz-daten->queue/-meta erwartet). NICHT in
;; tests/alltests.json registriert - manueller Einzelaufruf, bei Bedarf
;; spaeter dort ergaenzen.
(defun c:TEST_LINIENZUG_STUFE2 ( / json-datei)
(setq json-datei
(strcat (getenv "DXFMAKRO") "\\tests\\testdata\\linienzug_tests_stufe2.json"))
(tlz-run-datei json-datei "LZ_Stufe2_Kettenende" "TEST_LINIENZUG_STUFE2")
(princ)
)
;; ============================================================
;; MODUS 2 (aus 3D-Linie mit Zielhoehe) - Replay zweier echter Laeufe
;; ============================================================
;; Anders als die Modus-1-Faelle oben braucht Modus 2 KEINE Mocks und KEINEN
;; gezeichneten Pfad: sein Journal traegt einen SEGS-Eintrag mit der kompletten
;; Segment-Essenz (Typ, Richtung, Laenge, Eckwinkel, Seite, Start/Ende), ist
;; also von den Original-Objekten unabhaengig - dieselbe Eigenschaft, auf der
;; schon vfl-konvertiere-ent beruht (vfl-journal-hat-segs-p). Der Test spielt
;; daher das echte, aus der Zeichnung ausgelesene Journal ab.
;;
;; Die beiden Faelle sind BEWUSST ein Paar: derselbe Pfad, nur die 90-Grad-Ecke
;; einmal als Vario-Kurve (waagerecht) und einmal als GF-Bogen (geneigt). Sie
;; laufen durch verschiedene Zweige - mit und ohne flache Zone - und genau der
;; VERGLEICH hat am 2026-10-26/27 Fehler aufgedeckt, die ein einzelner Lauf
;; nicht gezeigt haette (ES-Fussabdruck am falschen Segment: 878 mm nur in der
;; GF-Bogen-Variante). Einen davon zu loeschen nimmt dem Test seinen Wert.
;;
;; Aufgezeichnet mit lib/vf_journal_export.py aus einem echten BricsCAD-Lauf.
;; Pruefkriterium (Nutzer-Vorgabe 2026-10-26): quer zur ES-KS_AUS-Achse und dZ
;; MUESSEN ~0 sein, laengs DARF abweichen (Ausladung des ES-Elements).
(setq *tlz-m2-toleranz* 1.0) ; mm; 0.2 ist die Messaufloesung der Blockmasse
;; Wert als String - eigene Kopie statt hmrec:als-string aus
;; test_hm_recformat.lsp: diese Datei soll fuer sich allein ladbar bleiben.
(defun tlz-m2-str (v)
(cond ((null v) "")
((= (type v) 'STR) v)
((= (type v) 'INT) (itoa v))
((= (type v) 'REAL) (rtos v 2 6))
(T (vl-princ-to-string v))))
;; Ein JSON-Record -> Journal-Eintrag (kind . wert), nil bei Metadaten-Zeile.
(defun tlz-m2-eintrag->journal (e / art)
(setq art (ssg-val e "art"))
(cond
((null art) nil)
((= art "PT") (cons "PT" (list (float (ssg-val e "x"))
(float (ssg-val e "y"))
(float (ssg-val e "z")))))
((= art "REAL") (cons "REAL" (float (ssg-val e "wert"))))
((= art "INT") (cons "INT" (fix (ssg-val e "wert"))))
;; SEGS traegt im Journal eine LISTE von Segment-Records, nicht den
;; String - genau diese Umwandlung macht auch der XDATA-Decoder
;; (vfl-journal-string->entry). Ohne sie bekommt vfl-in-segmente den
;; Rohstring und der erste mapcar darauf stirbt (real 2026-10-27).
((= art "SEGS") (cons "SEGS" (vfl-string->segs (tlz-m2-str (ssg-val e "wert")))))
(T (cons art (tlz-m2-str (ssg-val e "wert"))))))
;; Einen Modus-2-Fall abspielen. Rueckgabe: (status laengs quer dz offen).
(defun tlz-m2-run (json-datei test-id anzeige /
daten journal meta offen err status abw j
old-headless old-gui quer dz laengs)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(princ (strcat "\n\n--- " anzeige " ---"))
;; Vorbelegen, damit der Ergebnis-Record auch im Fehlerzweig Zahlen hat -
;; sonst stirbt das abschliessende rtos an nil (real passiert 2026-10-27).
(setq laengs 0.0 quer 999.0 dz 999.0 offen 0 status "FEHLER")
(setq daten (ssg-load-json json-datei))
(if (null daten)
(progn (princ (strcat "\n FEHLER: Testdaten fehlen: " json-datei))
(setq status "FEHLER"))
(progn
(setq meta (car daten))
(setq journal '())
(foreach e daten
(setq j (tlz-m2-eintrag->journal e))
(if j (setq journal (cons j journal))))
(setq journal (reverse journal))
(princ (strcat "\n Journal-Eintraege: " (itoa (length journal))))
(if meta (princ (strcat "\n Szenario: " (ssg-val meta "kurz"))))
(ssg-start anzeige '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0)
;; GUI aus (keine Wizard-Dialoge) UND headless: eine erschoepfte
;; Replay-Queue ist damit ein harter Abbruch MIT Fundstelle statt eines
;; stillen Rueckfalls auf eine Live-Abfrage, die im Batch haengen wuerde.
(setq old-gui *ssg-gui-aus* old-headless *vfl-headless*)
(if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
(setq *vfl-headless* T *vfl-m2-abweichung* nil)
(vfl-journal-replay-start journal)
(setq err (vl-catch-all-apply 'vf-linienzug-modus2 '()))
(setq *vfl-headless* old-headless *ssg-gui-aus* old-gui)
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (if (null old-gui) (ssg-gui-an)))
(setq offen (length *vfl-replay-queue*))
(setq abw (if (boundp '*vfl-m2-abweichung*) *vfl-m2-abweichung* nil))
(setq laengs (if abw (car abw) 0.0)
quer (if abw (cadr abw) 999.0)
dz (if abw (caddr abw) 999.0))
(cond
((vl-catch-all-error-p err)
(setq status "FEHLER")
(princ (strcat "\n FEHLER: " (vl-catch-all-error-message err))))
((null abw)
(setq status "FEHLER")
(princ "\n FEHLER: keine Abweichung gemessen (Bau nicht beendet)."))
(T
(princ (strcat "\n laengs=" (rtos laengs 2 1)
" quer=" (rtos quer 2 1)
" dZ=" (rtos dz 2 1) " mm"))
(if (> offen 0)
(princ (strcat "\n WARNUNG: " (itoa offen)
" Journal-Eintraege NICHT verbraucht (Ablauf weicht ab).")))
(setq status
(if (and (<= (abs quer) *tlz-m2-toleranz*)
(<= (abs dz) *tlz-m2-toleranz*)
(= offen 0))
"OK" "ABWEICHUNG"))
(princ (strcat "\n -> " status
" (Soll: |quer| und |dZ| <= " (rtos *tlz-m2-toleranz* 2 1)
" mm, laengs frei)"))))
(ssg-end)))
(list status laengs quer dz offen))
(defun c:TEST_LINIENZUG_MODUS2 ( / basis a b)
;; Doppelte Backslashes: "\t" waere in AutoLISP ein TABULATOR, der Pfad
;; wuerde zu "...dxfmakros<TAB>ests<TAB>estdata" (real passiert 2026-10-27).
(setq basis (strcat (getenv "DXFMAKRO") "\\tests\\testdata\\"))
(princ "\n================================================================")
(princ "\n TEST_LINIENZUG_MODUS2 - zwei Varianten DERSELBEN Strecke")
(princ "\n================================================================")
(setq a (tlz-m2-run (strcat basis "linienzug_modus2_variokurve.json")
"LZ_M2_variokurve" "Variante A: Ecke = Vario-Kurve"))
(setq b (tlz-m2-run (strcat basis "linienzug_modus2_gfbogen.json")
"LZ_M2_gfbogen" "Variante B: Ecke = GF-Bogen"))
(princ "\n\n================================================================")
(princ (strcat "\n ERGEBNIS: Variante A " (car a) " | Variante B " (car b)))
(princ "\n================================================================")
;; Ergebnis fuer run-all (Konvention wie linienzug:export-results)
(setq *linienzug-m2-test-results*
(strcat " { \"test_id\": \"LZ_M2_variokurve\", \"status\": \"" (car a)
"\", \"quer_mm\": " (rtos (caddr a) 2 2)
", \"dz_mm\": " (rtos (cadddr a) 2 2) " },\n"
" { \"test_id\": \"LZ_M2_gfbogen\", \"status\": \"" (car b)
"\", \"quer_mm\": " (rtos (caddr b) 2 2)
", \"dz_mm\": " (rtos (cadddr b) 2 2) " }"))
(princ)
)