s.ayadi
ba01455d52
Ziel: eine VF_n-Kette soll aus einem Stapel Eingabedaten gebaut werden koennen - ohne Dialog, ohne Konsolenfrage. Fahrplan und Begruendungen in doc/TODO-plan-vf-interactive.md. Alle Aenderungen sind No-Ops, solange *ssg-gui-aus* und *vfl-headless* nil sind. Produktion (Lisp/vf_linienzug.lsp, Lisp/vf_core.lsp): - vfl-journal-reset im Dispatcher VOR die Modus-cond gezogen. Bisher nur im Modus-1-Zweig: ein frischer Modus-2-Lauf erbte das Journal des Vorlaufs und schrieb es in die XDATA, ein spaeterer Doppelklick spielte fremde Eingaben vor. - Lokale Variable "member" in vf-linienzug-modus2 umbenannt. Sie verdeckte im selben Scope das Builtin member, das weiter unten gebraucht wird - jedes Kletterer-Segment waere in "bad function" gelaufen. - Neu vfl-meldung: sammelt den Text nach *vfl-meldungen* + dbgmsg und zeigt ihn nur bei erlaubter GUI modal, sonst per princ. Die 12 Bau-Pfad-alerts darauf umgestellt; ein Alert blockierte sonst jeden Batch-Lauf, und sein Text ist die einzige Auskunft, WELCHE Sektion abgewiesen wurde. Die reinen Interaktiv-Alerts (fehlendes DCL, "nicht editierbar", "kein Journal") bleiben alert. - Neu *vfl-headless* (+ vfl-headless-p/-abbruch/-notausgang/-ort, Diagnose *vfl-headless-fehler*, optionaler Antwort-Hook *vfl-headless-antwort-fn*): eine erschoepfte Replay-Queue ist damit ein harter Abbruch MIT Fundstelle (Art der Eingabe, Glied- und Eingabe-Nummer) statt eines stillen Rueckfalls auf Live-Eingabe. Eingebaut in vfl-in-value, vfl-in-value-p, vfl-in-selection und vfl-in-abstand. - vfl-journal-reset loescht Meldungen und Diagnose mit (gehoeren zum Lauf); vfl-view-refresh ueberspringt headless _PLAN/_ZOOM. Testfall HundM05 (5 echte Ketten aus data/polylines.dxf): - tests/testdata/hundm05.json neu erzeugt aus den XDATA-Journalen der VF_n-Bloecke (lib/vf_journal_export.py) - flach, weil ssg-load-json zeilenweise liest. Die drei kopierten Ketten bekommen ihren echten Einfuegepunkt, nicht das veraltete HOEHE_VON-Attribut. - tests/test_hundm05.lsp arbeitet jetzt per Journal-Replay statt mit Eingabe-Mocks: ein echtes Journal fuehrt die geerbte Fahrtrichtung nicht mit (vfl-in-abstand journalisiert hz nur beim ersten Segment), ein Mock kann sie also nicht kennen. Schaltet *vfl-headless* ein und schreibt prompts, headless_fehler und meldungen ins Ergebnis-JSON. - Kettenschleife fangt je Kette: ein Fehler NACH dem Bau nimmt nicht mehr die restlichen Ketten mit. - entprev gibt es in AutoLISP nicht (nur entnext/entlast) - die Suche nach dem fertigen Block laeuft vorwaerts ab dem Zeichnungsstand vor dem Bau. Dieselbe Falle in tests/test_mubea.lsp mitbehoben; sie schlug dort nie zu, weil entlast immer sofort traf. Absicherung ohne CAD: - tests/test_vf_headless_statisch.py: eingechecktes Inventar aller alert/get*/ssget/new_dialog-Fundstellen je Funktion (ein neues getreal in einer Bau-Funktion faellt auf, auch wenn sein Zweig im Test nie erreicht wird), Praesenz des Riegels in allen vier Wrappern, Diagnose-Reset und die Reset-Reihenfolge im Dispatcher. Dazu ein Waechter gegen erfundene AutoLISP-Funktionen (entprev u.a.) - diese Fehlerklasse kostet sonst jedes Mal einen CAD-Lauf. - tests/test_hundm05.py prueft zusaetzlich prompts == 0, keine Headless-Abbrueche und keine Bau-Meldungen. tests/alltests.json: hundm05-Zeile laedt VarioFoerderer (nicht KreiselInsert) und bleibt bis zu einem gruenen CAD-Lauf abgeschaltet. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
668 lines
29 KiB
Common Lisp
668 lines
29 KiB
Common Lisp
;; ============================================================
|
|
;; test_hundm05.lsp - Integrationstest: baut die 5 VarioFoerderer-Linienzuege
|
|
;; der Anlage HundM (Kreisel mit fuenf daran haengenden Ketten) nach.
|
|
;;
|
|
;; Datenquelle: tests/testdata/hundm05.json, erzeugt von
|
|
;; python lib/vf_journal_export.py data/polylines.dxf \
|
|
;; tests/testdata/hundm05.json --csv results/HundM_export.csv
|
|
;; Das sind die EINGABE-JOURNALE der echten Ketten - ausgelesen aus der XDATA
|
|
;; (App SSG_VF_EDIT, Marker "linienzug") der VF_n-Bloecke in data/polylines.dxf,
|
|
;; also genau die Werte, mit denen die Ketten in BricsCAD gebaut wurden.
|
|
;;
|
|
;; JSON-Aufbau (FLACH, weil ssg-load-json zeilenweise liest - Details in
|
|
;; tests/testdata/object_data.md Abschnitt 8):
|
|
;; Kopf-Objekt (traegt "test_id"): test_id, anlagetyp, modus,
|
|
;; anzahl_eingaben, block, dxf_handle, startpunkt_mm,
|
|
;; rotation_grad, beschreibung, sivas_* , erwartung_hinweis
|
|
;; Eingabe-Objekt (traegt "typ"): point_abs | point_rel | real | int |
|
|
;; string | step - in exakter Frage-Reihenfolge
|
|
;; Ein Kopf-Objekt beginnt eine Kette, die folgenden Eingabe-Objekte gehoeren
|
|
;; dazu (hundm05:gruppiere).
|
|
;;
|
|
;; WARUM REPLAY UND KEINE EINGABE-MOCKS (Unterschied zu test_linienzug.lsp):
|
|
;; test_linienzug.lsp ersetzt getpoint/getstring/getint/getreal durch Mocks und
|
|
;; rechnet Punkte aus "dL"+"hz" selbst aus. Das geht nur, weil
|
|
;; linienzug_tests.json zu JEDEM Segment ein "hz" mitfuehrt. Ein echtes Journal
|
|
;; tut das nicht: vfl-in-abstand journalisiert die Fahrtrichtung NUR beim
|
|
;; allerersten Segment der Kette, jedes weitere erbt sie vom Vorgaenger. Ein
|
|
;; Mock kann diese geerbte Richtung nicht kennen - er wuerde einen Punkt in der
|
|
;; falschen Richtung liefern und die Projektion in vfl-neue-linie-messen ergaebe
|
|
;; eine falsche (bis auf 0 zusammenfallende) Laenge. Darum wird hier derselbe
|
|
;; Weg genommen, den die Produktion beim Editieren/Konvertieren nutzt:
|
|
;; vfl-journal-replay-start + vf-linienzug-modus (siehe vfl-konvertiere-ent in
|
|
;; Lisp/vf_linienzug.lsp). Die vfl-in-*-Wrapper ziehen ihre Werte dann direkt
|
|
;; aus der Replay-Queue - inklusive der Sonderregel fuer "hz".
|
|
;;
|
|
;; Voraussetzungen:
|
|
;; - SSG_LIB geladen (VarioFoerderer inkl. vf_linienzug, Gefaellestrecke,
|
|
;; ssg_core, ssg_dbg)
|
|
;; - Umgebungsvariable DXFMAKRO gesetzt
|
|
;;
|
|
;; Speichert (via SSG_RUN_ALL_TESTS bei "save":"dxf"):
|
|
;; tests/output/hundm05_tests.dxf
|
|
;; tests/output/hundm05_results.json (via hundm05:export-results)
|
|
;;
|
|
;; Aufruf in BricsCAD:
|
|
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_hundm05.lsp"))
|
|
;; TEST_HUNDM05 ; in der aktuellen Dimension (ssg-ils-dim-aktuell)
|
|
;; TEST_HUNDM05_2D ; erzwungen 2D
|
|
;; TEST_HUNDM05_3D ; erzwungen 3D
|
|
;;
|
|
;; Debug-Datei (nur wenn eingeschaltet): (dbg-schalter-on "hundm05")
|
|
;; schreibt hundm05.dbg ins DXFM_LOG-Verzeichnis (Journal je Kette als JSON).
|
|
;; ============================================================
|
|
|
|
|
|
;; ============================================================
|
|
;; Ergebnis-JSON
|
|
;; ============================================================
|
|
|
|
;; --- JSON-Hilfen fuer Diagnosefelder (Strings/String-Listen) ---
|
|
;; Die extra-Felder in hundm05:result-json werden ROH in das JSON gesetzt,
|
|
;; ein Text muss also selbst seine Anfuehrungszeichen mitbringen und die
|
|
;; JSON-Sonderzeichen maskieren.
|
|
(defun hundm05:json-escape (s / out i c)
|
|
(setq out "" i 1)
|
|
(while (<= i (strlen s))
|
|
(setq c (substr s i 1))
|
|
(setq out (cond ((= c "\"") (strcat out "\\\""))
|
|
((= c "\\") (strcat out "\\\\"))
|
|
((= c "\n") (strcat out " "))
|
|
(T (strcat out c))))
|
|
(setq i (1+ i)))
|
|
out)
|
|
|
|
(defun hundm05:json-str (s)
|
|
(if s (strcat "\"" (hundm05:json-escape s) "\"") "null"))
|
|
|
|
(defun hundm05:json-liste (lst / s first)
|
|
(setq s "[" first T)
|
|
(foreach x lst
|
|
(if (not first) (setq s (strcat s ", ")))
|
|
(setq s (strcat s (hundm05:json-str x)) first nil))
|
|
(strcat s "]"))
|
|
|
|
;; --- Headless-Diagnose der Produktion lesen ---
|
|
;; vfl-headless-abbruch (Lisp/vf_linienzug.lsp) legt bei erschoepfter
|
|
;; Replay-Queue Art der Eingabe, Glied-Nummer und Eingabe-Nummer ab. Das ist
|
|
;; die eigentliche Desync-Auskunft - ohne sie weiss man nur, DASS Werte offen
|
|
;; blieben, nicht WO der Ablauf abgewichen ist.
|
|
(defun hundm05:headless-fehler-text ( / f)
|
|
(if (and (boundp '*vfl-headless-fehler*) *vfl-headless-fehler*)
|
|
(progn
|
|
(setq f *vfl-headless-fehler*)
|
|
(strcat (cdr (assoc "was" f)) " @ " (cdr (assoc "ort" f))))
|
|
nil))
|
|
|
|
;; Zaehler der trotz allem erreichten Live-Eingaben (muss 0 bleiben).
|
|
(defun hundm05:prompts ()
|
|
(if (and (boundp '*hundm05-prompts*) *hundm05-prompts*) *hundm05-prompts* 0))
|
|
|
|
|
|
;; "dimension" haelt fest, in welcher Dimension (2D/3D) gebaut wurde. Das ist
|
|
;; KEINE Eigenschaft der Eingabedaten: hundm05.json beschreibt die Ketten
|
|
;; dimensionsfrei. Womit unsere Makros bauen, entscheidet ssg-ils-dim-aktuell -
|
|
;; unsere Bibliothek hat von jedem Block eine _2D- und eine _3D-Variante.
|
|
;; extra: Alist zusaetzlicher Felder ((name . wert-string)), wird als
|
|
;; JSON-Zahlen/Strings so uebernommen, wie sie uebergeben werden.
|
|
(defun hundm05:result-json (test-id kind status block-name block-handle
|
|
insert-point attribs extra /
|
|
json tag val first)
|
|
(setq json (strcat " {\n"
|
|
" \"test_id\": \"" test-id "\",\n"
|
|
" \"kind\": \"" kind "\",\n"
|
|
" \"status\": \"" status "\",\n"
|
|
" \"dimension\": \""
|
|
(if (and (boundp '*hundm05-dimension*) *hundm05-dimension*)
|
|
*hundm05-dimension* "?") "\",\n"
|
|
" \"block_name\": \"" (if block-name block-name "") "\",\n"
|
|
" \"block_handle\": \"" (if block-handle block-handle "") "\",\n"
|
|
" \"insert_point\": ["
|
|
(if insert-point
|
|
(strcat (rtos (car insert-point) 2 1) ", "
|
|
(rtos (cadr insert-point) 2 1) ", "
|
|
(rtos (if (caddr insert-point) (caddr insert-point) 0.0) 2 1))
|
|
"0.0, 0.0, 0.0")
|
|
"],\n"))
|
|
(foreach f extra
|
|
(setq json (strcat json " \"" (car f) "\": " (cdr f) ",\n")))
|
|
(setq json (strcat json " \"actual_attributes\": {"))
|
|
(setq first T)
|
|
(foreach att attribs
|
|
(setq tag (car att) val (cdr att))
|
|
(if (not first) (setq json (strcat json ",")))
|
|
(setq json (strcat json "\n \"" tag "\": \"" (if val val "") "\""))
|
|
(setq first nil))
|
|
(setq json (strcat json "\n }\n }"))
|
|
json
|
|
)
|
|
|
|
|
|
;; --- Aus einer Block-ENAME ein Ergebnis-JSON erzeugen ---
|
|
;; status: "executed" bei sauberem Lauf; ein abweichender Status (z.B. bei
|
|
;; einem Queue-Desync) wird durchgereicht, die Block-Angaben bleiben dabei
|
|
;; erhalten - sonst waere der betroffene Block im Ergebnis nicht auffindbar.
|
|
(defun hundm05:ent-json-status (test-id kind status ent extra / ed)
|
|
(if ent
|
|
(progn
|
|
(setq ed (entget ent))
|
|
(hundm05:result-json test-id kind status
|
|
(cdr (assoc 2 ed)) (cdr (assoc 5 ed)) (cdr (assoc 10 ed))
|
|
(ssg-attrib-read ent) extra))
|
|
(hundm05:result-json test-id kind "failed" nil nil nil nil extra))
|
|
)
|
|
|
|
(defun hundm05:ent-json (test-id kind ent extra)
|
|
(hundm05:ent-json-status test-id kind "executed" ent extra)
|
|
)
|
|
|
|
|
|
;; --- Letzten INSERT mit Blocknamen-Praefix suchen ---
|
|
;; AutoLISP kennt KEIN entprev (nur entnext und entlast) - rueckwaerts durch
|
|
;; die Zeichnung laufen geht also nicht. Gesucht wird darum VORWAERTS, wobei
|
|
;; der letzte Treffer gewinnt. Ein blosses (entlast) genuegt nicht: nach dem
|
|
;; Bau koennen weitere Objekte entstehen (z.B. Beschriftungstexte), entlast
|
|
;; ist dann nicht der gesuchte Block - genau daran scheiterte der Testlauf.
|
|
;; ab-ent = Stand der Zeichnung VOR dem Bau. Damit prueft die Suche nur die
|
|
;; neu entstandenen Objekte: schnell, und sie kann nicht versehentlich den
|
|
;; Block eines frueheren Baus liefern (siehe Kommentar bei -ab).
|
|
(defun hundm05:insert-prefix-p (ent pref / ed bn)
|
|
(setq ed (entget ent) bn (cdr (assoc 2 ed)))
|
|
(and ed (= (cdr (assoc 0 ed)) "INSERT") bn
|
|
(>= (strlen bn) (strlen pref))
|
|
(= (substr bn 1 (strlen pref)) pref)))
|
|
|
|
;; Vorwaertslauf ab ab-ent (nil = ganze Zeichnung); der LETZTE Treffer
|
|
;; gewinnt. Der entget-Test faengt ein inzwischen ungueltiges ab-ent ab
|
|
;; (entget liefert dann nil, entnext wuerde einen Fehler werfen).
|
|
(defun hundm05:suche-vorwaerts (pref ab-ent / ent found)
|
|
(setq ent (if (and ab-ent (entget ab-ent)) (entnext ab-ent) (entnext)))
|
|
(while ent
|
|
(if (hundm05:insert-prefix-p ent pref) (setq found ent))
|
|
(setq ent (entnext ent)))
|
|
found)
|
|
|
|
(defun hundm05:last-insert-prefix-ab (pref ab-ent / ent)
|
|
(if ab-ent
|
|
;; MIT Marker nur die neu entstandenen Objekte pruefen - und BEWUSST
|
|
;; ohne entlast-Kurzschluss: hat dieser Bau keinen Block erzeugt, waere
|
|
;; entlast der Block eines FRUEHEREN Baus und das Ergebnis wuerde der
|
|
;; falschen Kette zugeordnet. Kein Treffer = kein Block, das ist die
|
|
;; richtige Antwort.
|
|
(hundm05:suche-vorwaerts pref ab-ent)
|
|
(progn
|
|
;; Ohne Marker: erst entlast (der haeufige Fall, das gerade
|
|
;; eingefuegte Objekt), sonst die ganze Zeichnung.
|
|
(setq ent (entlast))
|
|
(if (and ent (hundm05:insert-prefix-p ent pref))
|
|
ent
|
|
(hundm05:suche-vorwaerts pref nil)))))
|
|
|
|
(defun hundm05:last-insert-prefix (pref)
|
|
(hundm05:last-insert-prefix-ab pref nil))
|
|
|
|
|
|
;; ============================================================
|
|
;; JSON-Eintraege -> Ketten
|
|
;; ============================================================
|
|
|
|
;; Das flache JSON-Array in Ketten gruppieren: ein Objekt mit "test_id" ist
|
|
;; ein Kopf und beginnt eine neue Kette, die folgenden Objekte mit "typ" sind
|
|
;; ihre Eingaben (Reihenfolge = Frage-Reihenfolge, bleibt erhalten).
|
|
;; Rueckgabe: Liste von (kopf eingaben-liste).
|
|
(defun hundm05:gruppiere (daten / ketten kopf eingaben)
|
|
(setq ketten '() kopf nil eingaben '())
|
|
(foreach obj daten
|
|
(cond
|
|
((ssg-val obj "test_id")
|
|
(if kopf
|
|
(setq ketten (cons (list kopf (reverse eingaben)) ketten)))
|
|
(setq kopf obj eingaben '()))
|
|
((ssg-val obj "typ")
|
|
(if kopf (setq eingaben (cons obj eingaben))))
|
|
)
|
|
)
|
|
(if kopf (setq ketten (cons (list kopf (reverse eingaben)) ketten)))
|
|
(reverse ketten)
|
|
)
|
|
|
|
|
|
;; --- Wert als String lesen (auch wenn er als Zahl im JSON steht) ---
|
|
;; Die Menue-Antworten sind Strings ("1"/"2"/"90"/"30"). Steht in einer von
|
|
;; Hand gepflegten Datei versehentlich 1 statt "1", wuerde ein Zahlenwert in
|
|
;; die Replay-Queue wandern und der Vergleich (= antwort "1") schlagen fehl -
|
|
;; darum hier immer nach String wandeln.
|
|
(defun hundm05:als-string (v)
|
|
(cond
|
|
((null v) "")
|
|
((= (type v) 'STR) v)
|
|
((= (type v) 'INT) (itoa v))
|
|
((= (type v) 'REAL) (rtos v 2 6))
|
|
(T "")
|
|
)
|
|
)
|
|
|
|
|
|
;; --- Einen Eingabe-Eintrag in Journal-Eintraege uebersetzen ---
|
|
;; Journal-Format (vfl-entry->string in Lisp/vf_linienzug.lsp):
|
|
;; ("PT" x y z) / ("REAL" . r) / ("DL" . r) / ("INT" . i) / ("STR" . s) /
|
|
;; ("STEP" . label)
|
|
;; Ein "point_rel" wird zu EINEM oder ZWEI Eintraegen: immer die Laenge (DL),
|
|
;; zusaetzlich die Fahrtrichtung (REAL) nur dort, wo sie im Journal steht
|
|
;; (allererstes Segment der Kette, siehe Kopfkommentar).
|
|
;; Rueckgabe: Liste von Journal-Eintraegen (kann leer sein).
|
|
(defun hundm05:eintrag->journal (e / typ w hz)
|
|
(setq typ (ssg-val e "typ"))
|
|
(cond
|
|
((= typ "point_abs")
|
|
(setq w (ssg-val e "wert"))
|
|
(if (and w (listp w) (>= (length w) 3))
|
|
(list (cons "PT" (mapcar 'float w)))
|
|
nil))
|
|
((= typ "point_rel")
|
|
(setq w (ssg-val e "dL") hz (ssg-val e "hz"))
|
|
(cond
|
|
((not (numberp w)) nil)
|
|
((numberp hz) (list (cons "DL" (float w)) (cons "REAL" (float hz))))
|
|
(T (list (cons "DL" (float w))))))
|
|
((= typ "real")
|
|
(setq w (ssg-val e "wert"))
|
|
(if (numberp w) (list (cons "REAL" (float w))) nil))
|
|
((= typ "int")
|
|
(setq w (ssg-val e "wert"))
|
|
(if (numberp w) (list (cons "INT" (fix w))) nil))
|
|
((= typ "string")
|
|
(list (cons "STR" (hundm05:als-string (ssg-val e "wert")))))
|
|
((= typ "step")
|
|
(list (cons "STEP" (hundm05:als-string (ssg-val e "wert")))))
|
|
(T nil)
|
|
)
|
|
)
|
|
|
|
|
|
;; --- Alle Eingaben einer Kette in ein Vorwaerts-Journal uebersetzen ---
|
|
;; Vorwaerts = Bau-Reihenfolge, genau so erwartet es vfl-journal-replay-start.
|
|
(defun hundm05:journal-bauen (eingaben / out)
|
|
(setq out '())
|
|
(foreach e eingaben
|
|
(foreach j (hundm05:eintrag->journal e)
|
|
(setq out (cons j out))))
|
|
(reverse out)
|
|
)
|
|
|
|
|
|
;; --- Nicht verbrauchte Werte in der Replay-Queue zaehlen ---
|
|
;; STEP-Marker zaehlen nicht mit: vfl-replay-pop ueberspringt sie, sie sind
|
|
;; also kein offener Wert. Bleibt hier etwas uebrig, ist der Bau-Ablauf vom
|
|
;; aufgezeichneten abgewichen (Desync) - das MUSS auffallen.
|
|
(defun hundm05:queue-rest ( / n)
|
|
(setq n 0)
|
|
(if (and (boundp '*vfl-replay-queue*) *vfl-replay-queue*)
|
|
(foreach e *vfl-replay-queue*
|
|
(if (/= (car e) "STEP") (setq n (1+ n)))))
|
|
n
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; Eine Kette bauen
|
|
;; ============================================================
|
|
|
|
;; Spielt das Journal einer Kette ab. Ablauf wie vfl-konvertiere-ent
|
|
;; (Lisp/vf_linienzug.lsp): Queue setzen, vf-linienzug-modus laufen lassen,
|
|
;; danach den entstandenen VF_n-Block einsammeln.
|
|
;;
|
|
;; vl-catch-all-apply ist hier BEWUSST gesetzt (anders als im interaktiven
|
|
;; Editier-Pfad vfl-edit-ent): bricht eine Kette ab, muss die Testschleife
|
|
;; ueber die restlichen Ketten weiterlaufen. Der Preis ist derselbe wie beim
|
|
;; Batch-Konverter - der *error*-Handler in vf-linienzug-modus (der die
|
|
;; Teil-Geometrie zu einem Block wickelt) kommt dann nicht zum Zug und die
|
|
;; Teilgeometrie bleibt lose in der Zeichnung liegen. Der Testfall wird darum
|
|
;; klar als "failed" samt Fehlertext gemeldet.
|
|
;; *error* wird um den Aufruf herum gesichert: nach einem abgefangenen Abbruch
|
|
;; steht dort noch der Handler-Lambda von vf-linienzug-modus (es kommt nicht
|
|
;; mehr zu dessen (setq *error* old-error)) - ohne Restore wuerde die naechste
|
|
;; Kette auf einem Handler mit toten dynamischen Bindungen aufsetzen.
|
|
(defun hundm05:build-linienzug (kopf eingaben / tid journal anz offen err ent
|
|
alt-error extra hl-fehler meldungen vor-ent)
|
|
(setq tid (ssg-val kopf "test_id"))
|
|
(setq journal (hundm05:journal-bauen eingaben))
|
|
(setq anz (length journal))
|
|
(princ (strcat "\n [LINIENZUG] " tid " -> " (itoa (length eingaben))
|
|
" Eingaben, " (itoa anz) " Journal-Eintraege"))
|
|
(if (ssg-val kopf "beschreibung")
|
|
(princ (strcat "\n " (ssg-val kopf "beschreibung"))))
|
|
(if (and (boundp '*hundm05-dbg*) *hundm05-dbg*)
|
|
(progn
|
|
(dbgmsg (strcat "KETTE " tid " JOURNAL " (vfl-journal->json journal)))
|
|
(dbgflush)))
|
|
|
|
(cond
|
|
;; Ohne Journal (oder ohne Startpunkt an erster Stelle) nichts bauen: ein
|
|
;; Replay ohne PT wuerde den Startpunkt interaktiv erfragen und die ganze
|
|
;; Kette an der falschen Stelle aufbauen.
|
|
((null journal)
|
|
(princ (strcat "\n FEHLER: " tid " - keine Eingaben lesbar."
|
|
" Stehen die Zahlen-Arrays in EINER Zeile?"
|
|
" (ssg-cfg-parse-array kann keine umgebrochenen lesen)"))
|
|
(hundm05:result-json tid "linienzug" "failed" nil nil nil nil
|
|
(list (cons "eingaben_gesamt" (itoa anz))
|
|
(cons "eingaben_offen" (itoa anz)))))
|
|
|
|
((/= (car (car journal)) "PT")
|
|
(princ (strcat "\n FEHLER: " tid " - erster Eintrag ist kein"
|
|
" Startpunkt (point_abs), nichts gebaut."))
|
|
(hundm05:result-json tid "linienzug" "failed" nil nil nil nil
|
|
(list (cons "eingaben_gesamt" (itoa anz))
|
|
(cons "eingaben_offen" (itoa anz)))))
|
|
|
|
(T
|
|
;; Stand der Zeichnung VOR dem Bau: der fertige VF_-Block wird danach
|
|
;; ab hier gesucht (siehe hundm05:last-insert-prefix-ab).
|
|
(setq vor-ent (entlast))
|
|
(setq alt-error *error*)
|
|
(vfl-journal-reset)
|
|
(vfl-journal-replay-start journal)
|
|
(setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
|
|
(setq offen (hundm05:queue-rest))
|
|
;; Diagnose VOR dem Reset sichern: vfl-journal-reset loescht
|
|
;; *vfl-headless-fehler* und *vfl-meldungen* mit (beide gehoeren zum
|
|
;; einzelnen Lauf, nicht zur Sitzung).
|
|
(setq hl-fehler (hundm05:headless-fehler-text))
|
|
(setq meldungen (if (boundp '*vfl-meldungen*) *vfl-meldungen* nil))
|
|
(setq *error* alt-error)
|
|
(vfl-journal-reset)
|
|
(setq extra (list (cons "eingaben_gesamt" (itoa anz))
|
|
(cons "eingaben_offen" (itoa offen))
|
|
(cons "prompts" (itoa (hundm05:prompts)))
|
|
(cons "headless_fehler" (hundm05:json-str hl-fehler))
|
|
(cons "meldungen" (hundm05:json-liste meldungen))))
|
|
(cond
|
|
;; Der Headless-Riegel der Produktion hat gegriffen: die Journal-Daten
|
|
;; passen nicht zum tatsaechlichen Bau-Ablauf. Praeziser als "failed",
|
|
;; weil hl-fehler Glied UND Eingabe-Nummer nennt.
|
|
(hl-fehler
|
|
(princ (strcat "\n DESYNC: " tid " - " hl-fehler))
|
|
(hundm05:ent-json-status tid "linienzug" "desync"
|
|
(hundm05:last-insert-prefix-ab "VF_" vor-ent) extra))
|
|
((vl-catch-all-error-p err)
|
|
(princ (strcat "\n FEHLER: " tid " abgebrochen -> "
|
|
(vl-catch-all-error-message err)))
|
|
(hundm05:result-json tid "linienzug" "failed" nil nil nil nil extra))
|
|
;; Kette gebaut, aber der Ablauf hat nicht alle aufgezeichneten Werte
|
|
;; abgerufen: die Geometrie kann nicht der Vorlage entsprechen.
|
|
((> offen 0)
|
|
(princ (strcat "\n FEHLER: " tid " - " (itoa offen)
|
|
" Journal-Werte NICHT verbraucht (Ablauf weicht"
|
|
" von der Aufzeichnung ab)."))
|
|
(hundm05:ent-json-status tid "linienzug" "desync"
|
|
(hundm05:last-insert-prefix-ab "VF_" vor-ent) extra))
|
|
(T
|
|
(setq ent (hundm05:last-insert-prefix-ab "VF_" vor-ent))
|
|
(if ent
|
|
(princ (strcat " -> Block " (cdr (assoc 2 (entget ent)))))
|
|
(princ "\n FEHLER: kein VF_-Block gefunden"))
|
|
(hundm05:ent-json tid "linienzug" ent extra)))))
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; Headless-Absicherung: Dialoge aus, leere Queue bricht ab
|
|
;; ============================================================
|
|
;; Die Journale sind vollstaendig, es darf also keine Live-Eingabe geben.
|
|
;; Falls doch (Desync), wuerde ein getpoint/getstring den Testlauf blockieren
|
|
;; und ein alert-Fenster ihn haengen lassen. Darum werden die Eingabe-
|
|
;; Funktionen fuer die Dauer des Tests durch Abbruch-Stubs ersetzt (liefern
|
|
;; nil = Abbruch, was vf-linienzug-modus sauber beendet) und alert auf die
|
|
;; Konsole umgeleitet. Alles mit Save/Restore, siehe hundm05:stubs-aus.
|
|
;; Die Stubs haben feste 1- bzw. 2-Arity (AutoLISP kennt keine optionalen
|
|
;; Parameter) - genau wie die Mocks in test_linienzug.lsp. Ruft der Bau-Ablauf
|
|
;; eine der Funktionen mit anderer Argumentzahl auf, gibt es einen
|
|
;; Argumentfehler statt einer Warnung; beides landet im vl-catch-all-apply um
|
|
;; vf-linienzug-modus und meldet die Kette als "failed". Wichtig ist nur, dass
|
|
;; kein Prompt und kein Dialog den Lauf blockiert.
|
|
(defun hundm05:stub-warnung (was)
|
|
(setq *hundm05-prompts* (1+ (hundm05:prompts)))
|
|
(princ (strcat "\n WARNUNG: unerwartete Live-Eingabe (" was
|
|
") - Replay-Queue leer, Kette wird abgebrochen."))
|
|
nil
|
|
)
|
|
(defun hundm05:stub-getpoint (a b) (hundm05:stub-warnung "getpoint"))
|
|
(defun hundm05:stub-getstring (a) (hundm05:stub-warnung "getstring"))
|
|
(defun hundm05:stub-getint (a) (hundm05:stub-warnung "getint"))
|
|
(defun hundm05:stub-getreal (a) (hundm05:stub-warnung "getreal"))
|
|
(defun hundm05:stub-alert (msg)
|
|
(princ (strcat "\n ALERT (unterdrueckt): " (if msg msg "")))
|
|
(princ)
|
|
)
|
|
|
|
(defun hundm05:stubs-an ( / )
|
|
(setq *hundm05-alt-getpoint* vfl-getpoint
|
|
*hundm05-alt-getstring* getstring
|
|
*hundm05-alt-getint* getint
|
|
*hundm05-alt-getreal* getreal
|
|
*hundm05-alt-alert* alert)
|
|
(setq vfl-getpoint hundm05:stub-getpoint
|
|
getstring hundm05:stub-getstring
|
|
getint hundm05:stub-getint
|
|
getreal hundm05:stub-getreal
|
|
alert hundm05:stub-alert)
|
|
;; Wizard-Dialoge aus (waehrend eines Replays greifen sie ohnehin nicht,
|
|
;; siehe vfl-wizard-aktiv - aber nach einem Desync wuerde ein Dialog
|
|
;; aufgehen und warten).
|
|
(setq *hundm05-alt-wizard* (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*))
|
|
(setq *vfl-wizard-mode* nil)
|
|
(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
|
|
;; auf Live-Eingabe (siehe vfl-headless-abbruch). Die Stubs oben bleiben als
|
|
;; zweites Netz - sie fangen die Prompts ausserhalb der vfl-in-*-Wrapper
|
|
;; (Modus 3, Nebenpfade) und zaehlen sie.
|
|
(setq *hundm05-alt-headless* (if (boundp '*vfl-headless*) *vfl-headless*))
|
|
(setq *vfl-headless* T)
|
|
(setq *hundm05-prompts* 0)
|
|
(princ)
|
|
)
|
|
|
|
(defun hundm05:stubs-aus ( / )
|
|
(setq vfl-getpoint *hundm05-alt-getpoint*
|
|
getstring *hundm05-alt-getstring*
|
|
getint *hundm05-alt-getint*
|
|
getreal *hundm05-alt-getreal*
|
|
alert *hundm05-alt-alert*)
|
|
(setq *vfl-wizard-mode* *hundm05-alt-wizard*)
|
|
(setq *vfl-headless* *hundm05-alt-headless*)
|
|
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
|
|
(princ)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; Alle Ketten bauen
|
|
;; ============================================================
|
|
;; Eigene Funktion, damit der Aufrufer sie in vl-catch-all-apply klammern und
|
|
;; die Eingabe-Stubs GARANTIERT zuruecknehmen kann (ein hier entkommender
|
|
;; Fehler wuerde sonst getstring/getpoint/alert der laufenden BricsCAD-Sitzung
|
|
;; ersetzt zuruecklassen).
|
|
;; Rueckgabe: Ergebnis-Liste in Bau-Reihenfolge.
|
|
(defun hundm05:ketten-bauen (ketten / kette res out tid fehlertext)
|
|
(setq out '())
|
|
(foreach kette ketten
|
|
;; Dimensions-Override je Kette neu setzen: der Abbruch-Handler in
|
|
;; vf-linienzug-modus setzt *ssg-ils-dim* zurueck, ein Abbruch wuerde die
|
|
;; folgenden Ketten sonst in der falschen Dimension bauen.
|
|
(if (and (boundp '*hundm05-dim-override*) *hundm05-dim-override*)
|
|
(setq *ssg-ils-dim* *hundm05-dim-override*))
|
|
;; Je Kette gefangen: ein Fehler NACH dem Bau (z.B. beim Auswerten des
|
|
;; Ergebnisses) darf nicht die restlichen Ketten mitnehmen - sonst steht
|
|
;; am Ende "0 OK, 0 Fehler" und man sieht nicht einmal, welche Kette
|
|
;; gebaut wurde. Der Bau selbst ist in hundm05:build-linienzug bereits
|
|
;; separat gefangen; dieser Riegel hier deckt alles danach ab.
|
|
(setq tid (ssg-val (car kette) "test_id"))
|
|
(setq res (vl-catch-all-apply 'hundm05:build-linienzug
|
|
(list (car kette) (cadr kette))))
|
|
(if (vl-catch-all-error-p res)
|
|
(progn
|
|
(setq fehlertext (vl-catch-all-error-message res))
|
|
(princ (strcat "\n FEHLER: " tid " - Ausnahme: " fehlertext))
|
|
(setq res (hundm05:result-json tid "linienzug" "failed"
|
|
nil nil nil nil
|
|
(list (cons "fehler_text"
|
|
(hundm05:json-str fehlertext)))))))
|
|
(if res (setq out (cons res out))))
|
|
(reverse out)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; JSON-Export der Ergebnisse
|
|
;; ============================================================
|
|
(defun hundm05:export-results (tests-out-dir / out-json f first)
|
|
(if (null *hundm05-test-results*)
|
|
(princ "\n Keine HundM05-Ergebnisse vorhanden.")
|
|
(progn
|
|
(vl-mkdir tests-out-dir)
|
|
(setq out-json (strcat tests-out-dir "/hundm05_results.json"))
|
|
(setq f (open out-json "w"))
|
|
(if f
|
|
(progn
|
|
(write-line "[" f)
|
|
(setq first T)
|
|
(foreach r *hundm05-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!")))))
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; C:TEST_HUNDM05 - Hauptbefehl
|
|
;; ============================================================
|
|
(defun c:TEST_HUNDM05 ( / json-datei daten ketten results-list res
|
|
anz-ok anz-fehler)
|
|
;; Debug-Datei nur bei eingeschaltetem Schalter: (dbg-schalter-on "hundm05")
|
|
(setq *hundm05-dbg*
|
|
(and (car (atoms-family 1 '("DBG-SCHALTER-OPEN")))
|
|
(dbg-schalter-open "hundm05" "hundm05.dbg" "DXFM_LOG")))
|
|
|
|
;; Benoetigte Feature-Module laden (Linienzug braucht Vario + Gefaelle)
|
|
(ssg-ensure "VarioFoerderer")
|
|
(ssg-ensure "Gefaellestrecke")
|
|
|
|
(if (null (car (atoms-family 1 '("VF-LINIENZUG-MODUS"))))
|
|
(progn
|
|
(princ "\n[TEST_HUNDM05] FEHLER: vf-linienzug-modus nicht geladen"
|
|
" (VarioFoerderer/Gefaellestrecke laden).")
|
|
(if *hundm05-dbg* (dbgclose))
|
|
(exit)))
|
|
|
|
(ssg-start "TEST_HUNDM05" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
|
|
(setvar "OSMODE" 0)
|
|
(setvar "ATTREQ" 0)
|
|
(setvar "ATTDIA" 0)
|
|
|
|
;; Block-Bibliothek (Bogen-/AS-/ES-Masse) initialisieren
|
|
(if (or (not *lib-initialized*) (null bogen-auf))
|
|
(init-bibliothek))
|
|
|
|
;; Bau-Dimension festhalten. Die Eingabedaten sind dimensionsfrei; welche
|
|
;; Blockvariante (_2D/_3D) verwendet wird, loest ssg-ils-dim-aktuell auf
|
|
;; (Override *ssg-ils-dim* -> Umgebungsvariable DXFM_DIM -> Default "3D").
|
|
(setq *hundm05-dimension* (ssg-ils-dim-aktuell))
|
|
(princ (strcat "\n Bau-Dimension: " *hundm05-dimension*
|
|
" (umschalten: TEST_HUNDM05_2D / TEST_HUNDM05_3D)"))
|
|
|
|
;; Testdaten laden
|
|
(setq json-datei (strcat (getenv "DXFMAKRO") "/tests/testdata/hundm05.json"))
|
|
(if (not (findfile json-datei))
|
|
(progn
|
|
(princ (strcat "\n[TEST_HUNDM05] FEHLER: " json-datei " nicht gefunden!"))
|
|
(ssg-end)
|
|
(if *hundm05-dbg* (dbgclose))
|
|
(exit)))
|
|
(setq daten (ssg-load-json json-datei))
|
|
(if (null daten)
|
|
(progn
|
|
(princ "\n[TEST_HUNDM05] FEHLER: Testdaten konnten nicht geladen werden.")
|
|
(ssg-end)
|
|
(if *hundm05-dbg* (dbgclose))
|
|
(exit)))
|
|
|
|
(setq ketten (hundm05:gruppiere daten))
|
|
(if (null ketten)
|
|
(progn
|
|
(princ "\n[TEST_HUNDM05] FEHLER: keine Kette gefunden - erwartet werden"
|
|
" Kopf-Objekte mit \"test_id\" und Eingaben mit \"typ\".")
|
|
(ssg-end)
|
|
(if *hundm05-dbg* (dbgclose))
|
|
(exit)))
|
|
|
|
(princ "\n\n================================================================")
|
|
(princ "\n TEST_HUNDM05 - 5 Linienzuege der Anlage HundM (polylines.dxf)")
|
|
(princ (strcat "\n " (itoa (length daten)) " JSON-Objekte, "
|
|
(itoa (length ketten)) " Ketten"))
|
|
(princ "\n================================================================")
|
|
|
|
(setq anz-ok 0 anz-fehler 0)
|
|
(hundm05:stubs-an)
|
|
;; Stubs MUESSEN auch nach einem unerwarteten Fehler zurueckgenommen werden.
|
|
(setq results-list (vl-catch-all-apply 'hundm05:ketten-bauen (list ketten)))
|
|
(hundm05:stubs-aus)
|
|
(if (vl-catch-all-error-p results-list)
|
|
(progn
|
|
(princ (strcat "\n[TEST_HUNDM05] FEHLER in der Kettenschleife: "
|
|
(vl-catch-all-error-message results-list)))
|
|
(setq results-list '())))
|
|
|
|
(foreach res results-list
|
|
(if (vl-string-search "\"status\": \"executed\"" res)
|
|
(setq anz-ok (1+ anz-ok))
|
|
(setq anz-fehler (1+ anz-fehler))))
|
|
|
|
(princ "\n================================================================")
|
|
(princ (strcat "\n Ergebnis: " (itoa anz-ok) " OK, "
|
|
(itoa anz-fehler) " Fehler"))
|
|
(princ "\n================================================================")
|
|
|
|
(setq *hundm05-test-results* results-list)
|
|
|
|
(ssg-end)
|
|
(princ "\n TEST_HUNDM05 abgeschlossen.")
|
|
(if *hundm05-dbg* (dbgclose))
|
|
(princ)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; Dieselbe Anlage in einer bestimmten Dimension bauen
|
|
;; ============================================================
|
|
;; Die Eingabedaten (hundm05.json) sind dimensionsfrei - sie beschreiben die
|
|
;; Eingaben, mit denen die Ketten gebaut wurden. Ob daraus flache 2D-Symbole
|
|
;; oder 3D-Modelle werden, entscheidet allein die Blockvariante (_2D/_3D), die
|
|
;; ssg-ils-dim-aktuell aufloest. Unsere Bibliothek hat beide, also laesst sich
|
|
;; dieselbe Anlage ohne Datenaenderung in 2D ODER 3D aufbauen.
|
|
;; *hundm05-dim-override* wird in der Kettenschleife je Kette neu gesetzt
|
|
;; (siehe dort).
|
|
(defun hundm05:mit-dimension (dim / alt ergebnis)
|
|
(setq alt (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
|
|
(setq *ssg-ils-dim* dim)
|
|
(setq *hundm05-dim-override* dim)
|
|
(princ (strcat "\n[TEST_HUNDM05] Dimension voruebergehend auf " dim
|
|
" gesetzt."))
|
|
(setq ergebnis (c:TEST_HUNDM05))
|
|
;; Override wieder auf den vorherigen Stand - sonst baut ein folgender Test
|
|
;; unbemerkt in der hier gewaehlten Dimension weiter.
|
|
(setq *ssg-ils-dim* alt)
|
|
(setq *hundm05-dim-override* nil)
|
|
(princ (strcat "\n[TEST_HUNDM05] Dimension zurueckgesetzt auf "
|
|
(if alt alt "Umgebung/Default") "."))
|
|
ergebnis
|
|
)
|
|
|
|
(defun c:TEST_HUNDM05_2D ( / ) (hundm05:mit-dimension "2D"))
|
|
(defun c:TEST_HUNDM05_3D ( / ) (hundm05:mit-dimension "3D"))
|