Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
72a4637bd20f432a34ec5b3ed4f698c130eff101
dxfmakros/tests/test_foerderer.lsp
T

432 lines
18 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_foerderer.lsp - Automatischer Integrationstest fuer VarioFoerderer
;;
;; Liest Testfaelle aus tests/testdata/foerderer_tests.json.
;; Speichert:
;; - tests/output/foerderer_results.json (Ergebnisse)
;;
;; Voraussetzungen:
;; - SSG_LIB geladen (VarioFoerderer.lsp, ssg_core.lsp)
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_foerderer.lsp"))
;; TEST_FOERDERER
;; ============================================================
;; --- Ergebnis eines Testfalls als JSON-String erzeugen ---
(defun foerderer:test-result-json (test-id richtung deltaL deltaH status
winkel L_GF L_VF /
json)
(setq json (strcat " {\n"
" \"test_id\": \"" test-id "\",\n"
" \"richtung\": \"" richtung "\",\n"
" \"deltaL\": " (rtos deltaL 2 0) ",\n"
" \"deltaH\": " (rtos deltaH 2 0) ",\n"
" \"status\": \"" status "\""))
(if winkel
(setq json (strcat json ",\n"
" \"winkel\": " (itoa winkel) ",\n"
" \"L_GF\": " (rtos L_GF 2 1) ",\n"
" \"L_VF\": " (rtos L_VF 2 1)))
)
(setq json (strcat json "\n }"))
json
)
;; --- JSON-Export der Foerderer-Testergebnisse ---
(defun foerderer:export-results (tests-out-dir / out-json f first)
(if (null *foerderer-test-results*)
(princ "\n Keine Foerderer-Ergebnisse vorhanden.")
(progn
(vl-mkdir tests-out-dir)
(setq out-json (strcat tests-out-dir "/foerderer_results.json"))
(setq f (open out-json "w"))
(if f
(progn
(write-line "[" f)
(setq first T)
(foreach r *foerderer-test-results*
(if (not first) (write-line "," f))
(write-line r f)
(setq first nil)
)
(write-line "]" f)
(close f)
(princ (strcat "\n Ergebnisse: " out-json))
)
(princ (strcat "\n FEHLER: Kann " out-json " nicht schreiben!"))
)
)
)
)
;; --- Einen VF-Testblock bauen und lastEnt hinter dessen SEQEND schieben ---
(defun foerderer:baue-block (startpunkt vf-nummer hoehe-von hoehe-bis
deltaH deltaL richtung best-winkel
L_GF1 L_GF2 L_VF lastEnt /
sub-ent)
(variofoerderer-einfuegen deltaL deltaH richtung best-winkel
L_GF1 L_GF2 L_VF
startpunkt "links" 0.0)
(vf-block-erstellen "standard" "links" vf-nummer 0
hoehe-von hoehe-bis deltaH deltaL L_VF
L_GF1 L_GF2
richtung best-winkel startpunkt lastEnt 0.0)
;; lastEnt hinter den SEQEND des VF-Blocks schieben.
;; Ohne diesen Schritt wuerde entnext vom INSERT-Entity
;; in die ATTRIB-Kette des gerade erstellten VF-Blocks
;; springen und diese beim naechsten _.-BLOCK-Aufruf
;; in den neuen Block verschieben (Datenverlust).
(setq lastEnt (entlast))
(setq sub-ent (entnext lastEnt))
(while (and sub-ent
(not (equal (cdr (assoc 0 (entget sub-ent))) "SEQEND")))
(setq lastEnt sub-ent)
(setq sub-ent (entnext lastEnt)))
(if sub-ent (setq lastEnt sub-ent))
lastEnt
)
;; ============================================================
;; C:TEST_FOERDERER - Hauptbefehl
;; ============================================================
(defun c:TEST_FOERDERER ( / json-datei testdaten cfg tests
eintrag test-id richtung deltaL deltaH
ergebnis best-winkel L_GF L_VF horizontal-info
y-offset y-abstand idx blk-nummer
anz-gebaut anz-nicht-gebaut results-list
startpunkt hoehe-von hoehe-bis lastEnt
sub-typ)
;; Bibliothek initialisieren (laedt Block-Library und extrahiert Masse).
;; Auch bei gesetztem Flag, aber leerer Bogen-Tabelle neu initialisieren
;; (Selbstheilung gegen Stuck-State).
(if (or (not *lib-initialized*) (null bogen-auf))
(init-bibliothek)
)
(ssg-start "TEST_FOERDERER" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; Testdaten aus JSON laden
(setq json-datei
(strcat (getenv "DXFMAKRO")
"\\tests\\testdata\\foerderer_tests.json"))
(setq testdaten (ssg-load-json json-datei))
(if (null testdaten)
(progn
(alert (strcat "Testdaten nicht gefunden:\n" json-datei))
(ssg-end)
(exit)
)
)
;; Konfiguration aus erstem Eintrag (ohne test_id)
(setq cfg (car testdaten))
(setq y-abstand (ssg-val cfg "y_abstand"))
(if (or (null y-abstand) (= y-abstand 0)) (setq y-abstand 800))
;; Nur Eintraege mit test_id sind Testfaelle
(setq tests
(vl-remove-if-not
'(lambda (e) (ssg-val e "test_id"))
testdaten))
(setq y-offset 0)
(setq idx 0)
(setq blk-nummer 0)
(setq results-list '())
(setq anz-gebaut 0)
(setq anz-nicht-gebaut 0)
(princ "\n")
(princ "\n================================================================")
(princ "\n TEST_FOERDERER - Variofoerderer Integrationstest")
(princ "\n================================================================")
(princ (strcat "\n Testdaten: " json-datei))
(princ (strcat "\n Testfaelle: " (itoa (length tests))))
(princ (strcat "\n Y-Abstand: " (rtos y-abstand 2 0) " mm"))
(princ "\n================================================================")
;; ==========================================================
;; Alle Testfaelle aus JSON ausfuehren
;; ==========================================================
(foreach eintrag tests
(setq test-id (ssg-val eintrag "test_id"))
(setq richtung (ssg-val eintrag "richtung"))
(setq deltaL (float (ssg-val eintrag "deltaL")))
(setq deltaH (float (ssg-val eintrag "deltaH")))
(setq idx (1+ idx))
;; Geometrisch unmoeglich: Ab mit deltaH=0
(if (and (= richtung "Ab") (< deltaH 1))
(progn
(setq anz-nicht-gebaut (1+ anz-nicht-gebaut))
(princ (strcat "\n " (itoa idx) ". " test-id " -> GEOMETRISCH_UNMOEGLICH"))
(setq results-list (cons
(foerderer:test-result-json test-id richtung deltaL deltaH
"GEOMETRISCH_UNMOEGLICH" nil nil nil)
results-list))
)
(progn
(setq ergebnis (berechne-alle-winkel deltaL deltaH richtung nil))
(setq best-winkel (car ergebnis))
(setq L_GF (cadr ergebnis))
(setq L_VF (caddr ergebnis))
(if (and best-winkel L_GF L_VF (> L_GF 0) (> L_VF 0))
(progn
(setq anz-gebaut (1+ anz-gebaut))
(princ (strcat "\n " (itoa idx) ". " test-id " -> GEBAUT "
(itoa best-winkel) " Grad L_GF=" (rtos L_GF 2 1)
" L_VF=" (rtos L_VF 2 1)))
(setq startpunkt (list 0 y-offset 0))
(setq blk-nummer (1+ blk-nummer))
(setq hoehe-von 0)
(setq hoehe-bis (if (= richtung "Auf") deltaH (- deltaH)))
;; Wie c:VarioFoerderer: Attribut-Entities/SEQEND des vorherigen
;; VF_N-Blocks ueberspringen, sonst rutschen sie in den naechsten
;; Block hinein (Blockerstellung faengt sonst am falschen Entity an).
(setq lastEnt (vf-lastent-ohne-attribute))
(setq lastEnt
(foerderer:baue-block startpunkt blk-nummer hoehe-von hoehe-bis
deltaH deltaL richtung best-winkel
(/ L_GF 2.0) (/ L_GF 2.0) L_VF lastEnt))
(setq results-list (cons
(foerderer:test-result-json test-id richtung deltaL deltaH
"GEBAUT" best-winkel L_GF L_VF)
results-list))
)
(progn
(setq anz-nicht-gebaut (1+ anz-nicht-gebaut))
(princ (strcat "\n " (itoa idx) ". " test-id " -> NICHT_GEBAUT"))
(setq results-list (cons
(foerderer:test-result-json test-id richtung deltaL deltaH
"NICHT_GEBAUT" nil nil nil)
results-list))
)
)
;; Zusaetzlich: Horizontale Variofoerderer-Mittelsektion (0 Grad)
;; pruefen und als eigenen Testfall bauen, falls bei richtung="Ab"
;; geometrisch moeglich (analog Schritt 5b in c:VarioFoerderer).
(if (= richtung "Ab")
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab"))
(if (and horizontal-info (caddr horizontal-info))
(progn
(setq anz-gebaut (1+ anz-gebaut))
(princ (strcat "\n " (itoa idx) ". " test-id
" -> GEBAUT (Horizontale Variofoerderer 0"
(chr 176) ") L_GF=" (rtos (car horizontal-info) 2 1)
" L_VF=" (rtos (cadr horizontal-info) 2 1)))
(setq y-offset (- y-offset y-abstand))
(setq startpunkt (list 0 y-offset 0))
(setq blk-nummer (1+ blk-nummer))
(setq hoehe-von 0)
(setq hoehe-bis (- deltaH))
(setq lastEnt (vf-lastent-ohne-attribute))
(setq lastEnt
(foerderer:baue-block startpunkt blk-nummer hoehe-von hoehe-bis
deltaH deltaL "Ab" 0
(/ (car horizontal-info) 2.0)
(/ (car horizontal-info) 2.0)
(cadr horizontal-info) lastEnt))
(setq results-list (cons
(foerderer:test-result-json (strcat test-id "_HORIZONTAL") richtung
deltaL deltaH "GEBAUT" 0
(car horizontal-info) (cadr horizontal-info))
results-list))
)
)
)
)
)
)
(setq y-offset (- y-offset y-abstand))
)
;; ==========================================================
;; Zusammenfassung
;; ==========================================================
(princ "\n================================================================")
(princ (strcat "\n Ergebnis: " (itoa anz-gebaut) " GEBAUT, "
(itoa anz-nicht-gebaut) " NICHT_GEBAUT"))
(princ "\n================================================================")
;; Ergebnisse in globaler Variable speichern
(setq *foerderer-test-results* (reverse results-list))
(ssg-end)
(princ "\n================================================================")
(princ "\n TEST_FOERDERER abgeschlossen.")
(princ "\n================================================================")
(princ)
)
;; ============================================================
;; C:TEST_LINIENZUG - Regressionstest fuer den VF-Linienzug (Modus 1)
;; ------------------------------------------------------------
;; EIGENSTAENDIG: beruehrt weder c:TEST_FOERDERER noch dessen Funktionen.
;; ============================================================
;; 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.
;;
;; Repliziertes Szenario (aus manuellem Test):
;; Start Z=4500, AS rechts
;; -> Neue Linie (Ab, Ziel-Z=1800, Winkel 45 Grad), GF ganz am Einlauf
;; -> Horizontal 900 mm mit Separator VOR + NACH (beide horizontal, 0 Grad)
;; -> Vario-Kurve 90 links aussen
;; -> Horizontal 250 mm (ohne Separatoren)
;; -> Vario-Kurve 90 links aussen
;; -> Option 3 (Kettenende definieren): Ziel-Z=4500, Winkel 45 Grad, ES rechts
;;
;; Erwartetes Ergebnis (Ist-Ziel-Report):
;; 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_foerderer.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))
(defun c:TEST_LINIENZUG ( / 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================================================================")
(ssg-start "TEST_LINIENZUG" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; --- Skript der Eingaben in exakter Aufruf-Reihenfolge ---
(setq *tlz-q*
(list
(list 'A 0 0 0) ; getpoint Startpunkt der Kette
4500.0 ; getreal Hoehe (Z) Startpunkt
"2" ; getstring AS-Seite (rechts)
"1" ; getstring Naechstes Element (Neue Linie)
(list 'P 5500 0) ; getpoint Endpunkt Linie (frei, +X, dL=5500)
1800.0 ; getreal Hoehe (Z) Linienendpunkt
1 ; getint Winkelwahl (45 Grad)
"2" ; getstring GF-Verteilung (alles am Einlauf)
"2" ; getstring Ist Endpunkt? (Nein)
"1" ; getstring Naechstes im VF (Horizontal)
(list 'P 900 0) ; getpoint Horizontal-Endpunkt (dL=900, hz=0)
"1" ; getstring Separator VOR? (Ja)
"1" ; getstring Separator NACH? (Ja)
"2" ; getstring Ist Endpunkt? (Nein)
"2" ; getstring Naechstes (Vario-Kurve)
1 ; getint Kurve-Winkel (90)
"1" ; getstring Kurve-Seite (links)
"1" ; getstring Kurve-Variante (aussen)
"2" ; getstring Ist Endpunkt? (Nein)
"1" ; getstring Naechstes (Horizontal)
(list 'P 250 90) ; getpoint Horizontal-Endpunkt (dL=250, hz=90)
"2" ; getstring Separator VOR? (Nein)
"2" ; getstring Separator NACH? (Nein)
"2" ; getstring Ist Endpunkt? (Nein)
"2" ; getstring Naechstes (Vario-Kurve)
1 ; getint Kurve-Winkel (90)
"1" ; getstring Kurve-Seite (links)
"1" ; getstring Kurve-Variante (aussen)
"3" ; getstring Ist Endpunkt? (Option 3 - Kettenende)
(list 'P 6215 180) ; getpoint Option-3-Endpunkt (dL=6215, hz=180)
4500.0 ; getreal Hoehe (Z) Kettenende (ES)
2 ; getint Option-3-Winkelwahl (45 Grad)
"2" ; getstring ES-Seite (rechts)
)
)
;; --- 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)
(princ "\n================================================================")
(if (vl-catch-all-error-p err)
(princ (strcat "\n TEST_LINIENZUG: FEHLER -> "
(vl-catch-all-error-message err)))
(progn
(princ "\n TEST_LINIENZUG: Kette gebaut.")
(if *tlz-q*
(princ (strcat "\n WARNUNG: " (itoa (length *tlz-q*))
" Skript-Eintraege NICHT verbraucht (Ablauf weicht ab)."))
(princ "\n Alle Skript-Eingaben verbraucht (Ablauf wie erwartet)."))
(princ "\n Erwartung Ist-Ziel: dX~0, dZ~0, dY~637 mm (ES_90-Seitenversatz).")
)
)
(princ "\n================================================================")
(ssg-end)
(princ)
)
Reference in New Issue View Git Blame Copy Permalink