dxfmakros/tests/test_linienzug.lsp

;; ============================================================
;; 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          (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.
(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!"))
      )
    )
  )
)

;; --- 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)
  (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.
  (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 wieder einschalten (auch nach Fehler), damit eine folgende interaktive
  ;; Sitzung nicht headless bleibt.
  (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))

  (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)
)