218 lines
8.4 KiB
Common Lisp
218 lines
8.4 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":"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
|
|
;; ============================================================
|
|
|
|
;; 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.
|
|
(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)))
|
|
(if (and (listp spec) (= (car spec) 'A))
|
|
(list (float (cadr spec)) (float (caddr spec)) (float (cadddr spec)))
|
|
(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 "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!"))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun c:TEST_LINIENZUG ( / json-datei daten meta schritte-anz rest-anz status
|
|
old-vgp old-gs old-gi old-gr err)
|
|
(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 "\n TEST_LINIENZUG - VF-Linienzug Replay-Test")
|
|
(princ "\n================================================================")
|
|
|
|
;; --- Eingabe-Skript aus JSON laden ---
|
|
(setq json-datei
|
|
(strcat (getenv "DXFMAKRO") "\\tests\\testdata\\linienzug_tests.json"))
|
|
(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 "TEST_LINIENZUG" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
|
|
(setvar "OSMODE" 0)
|
|
(setvar "ATTREQ" 0)
|
|
(setvar "ATTDIA" 0)
|
|
|
|
;; --- 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)
|
|
|
|
(setq rest-anz (length *tlz-q*))
|
|
|
|
(princ "\n================================================================")
|
|
(if (vl-catch-all-error-p err)
|
|
(progn
|
|
(setq status "FEHLER")
|
|
(princ (strcat "\n TEST_LINIENZUG: FEHLER -> "
|
|
(vl-catch-all-error-message err))))
|
|
(progn
|
|
(setq status (if (= rest-anz 0) "OK" "ABWEICHUNG"))
|
|
(princ "\n TEST_LINIENZUG: 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\": \"LZ_Standard\",\n"
|
|
" \"status\": \"" status "\",\n"
|
|
" \"schritte_gesamt\": " (itoa schritte-anz) ",\n"
|
|
" \"schritte_offen\": " (itoa rest-anz) "\n"
|
|
" }"))
|
|
|
|
(ssg-end)
|
|
(princ)
|
|
)
|