dxfmakros/tests/test_run_all.lsp

;; ============================================================
;; test_run_all.lsp - Fuehrt alle LISP-Tests nacheinander aus
;;
;; Laedt und startet alle in tests/alltests.json registrierten Tests.
;; Konvention: Aus Basisname <name> leiten sich ab:
;;   Datei:    test_<name>.lsp
;;   Befehl:   TEST_<NAME>
;;   Export:   <name>:export-results
;;
;; Ergebnisse werden in tests/output/ gespeichert:
;;   JSON:  immer (<name>_results.json, via <name>:export-results)
;;   DXF:   wenn "save": "dxf" in alltests.json
;;   DWG:   wenn "save": "dwg" in alltests.json
;;   keins: wenn "save" fehlt, null oder leer
;;
;; Voraussetzungen:
;;   - SSG_LIB geladen
;;   - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;;   (load (strcat (getenv "DXFMAKRO") "/tests/test_run_all.lsp"))
;;   SSG_RUN_ALL_TESTS
;; ============================================================


;; --- Hilfsfunktion: String-Wert aus JSON-Objekt-Zeile lesen ---
;; Sucht "key": "value" in obj-str und gibt value zurueck.
;; Rueckgabe: String (nicht leer) oder nil (key fehlt, null, leer).
(defun alltests:get-str (obj-str key / pat pos val-start val-end val)
  (setq pat (strcat "\"" key "\": \""))
  (setq pos (vl-string-search pat obj-str))
  (if pos
    (progn
      (setq val-start (+ pos (strlen pat)))           ;; 0-basiert
      (setq val-end (vl-string-search "\"" obj-str val-start))
      (if val-end
        (progn
          (setq val (substr obj-str (1+ val-start) (- val-end val-start)))
          (if (> (strlen val) 0) val nil)
        )
      )
    )
  )
)


;; --- Testliste aus tests/alltests.json laden ---
;; Erwartet ein JSON-Array, je Zeile ein Objekt: { "name": "...", "save": "..." }
;; "save" kann "dxf", "dwg", null oder fehlen (= kein Speichern).
;; Rueckgabe: Liste von Assoc-Listen (("name" . "kreisel") ("save" . "dxf"))
(defun alltests:load (tests-pfad / json-datei f zeile ergebnis name save-fmt)
  (setq json-datei (strcat tests-pfad "/alltests.json"))
  (if (not (findfile json-datei))
    (progn
      (princ (strcat "\n  FEHLER: " json-datei " nicht gefunden!"))
      nil
    )
    (progn
      (setq f (open json-datei "r"))
      (if (null f)
        (progn
          (princ (strcat "\n  FEHLER: Kann " json-datei " nicht oeffnen!"))
          nil
        )
        (progn
          (setq ergebnis nil)
          (while (setq zeile (read-line f))
            ;; Jede Zeile mit "name" ist ein Test-Eintrag (ein Objekt pro Zeile)
            (if (vl-string-search "\"name\"" zeile)
              (progn
                (setq name     (alltests:get-str zeile "name"))
                (setq save-fmt (alltests:get-str zeile "save"))
                (if name
                  (setq ergebnis (cons
                    (list (cons "name" name) (cons "save" save-fmt))
                    ergebnis))
                )
              )
            )
          )
          (close f)
          (reverse ergebnis)
        )
      )
    )
  )
)


;; --- Konventionsbasierte Namen aus Basisname ableiten ---
;; Gibt Assoc-Liste zurueck: datei, befehl, export-fn
(defun test-module-names (name tests-pfad)
  (list
    (cons "datei"     (strcat tests-pfad "/test_" name ".lsp"))
    (cons "befehl"    (strcat "TEST_" (strcase name)))
    (cons "export-fn" (read (strcat name ":export-results")))
  )
)


(defun c:SSG_RUN_ALL_TESTS ( / tests-pfad tests-out-dir
                                idx anz entry name save-fmt
                                namen befehl datei export-fn
                                out-path test-result)

  (setq tests-pfad    (strcat (getenv "DXFMAKRO") "/tests"))
  (setq tests-out-dir (strcat tests-pfad "/output"))
  (vl-mkdir tests-out-dir)

  ;; Testliste aus alltests.json laden
  (setq *test-module* (alltests:load tests-pfad))
  (if (null *test-module*)
    (progn
      (princ "\n  FEHLER: Keine Test-Module geladen. Abbruch.")
      (exit)
    )
  )

  (setq anz (length *test-module*))
  (setq idx 0)

  (princ "\n")
  (princ "\n================================================================")
  (princ "\n  SSG_RUN_ALL_TESTS")
  (princ (strcat "\n  " (itoa anz) " Testmodule (aus alltests.json)"))
  (princ "\n================================================================")

  ;; Tests laden und ausfuehren
  ;; Vor jedem Test werden alle Entities geloescht, damit jeder
  ;; Testlauf eine eigene saubere Zeichnung erzeugt.
  (foreach entry *test-module*
    (setq idx      (1+ idx))
    (setq name     (cdr (assoc "name" entry)))
    (setq save-fmt (cdr (assoc "save" entry)))

    ;; Namen aus Konvention ableiten
    (setq namen     (test-module-names name tests-pfad))
    (setq datei     (cdr (assoc "datei"     namen)))
    (setq befehl    (cdr (assoc "befehl"    namen)))
    (setq export-fn (cdr (assoc "export-fn" namen)))

    (princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " befehl " <<<"))
    (if save-fmt
      (princ (strcat "  [save: " save-fmt "]"))
      (princ "  [kein Speichern]")
    )

    ;; Zeichnung leeren fuer sauberen Testlauf
    ;; Frozen Layer werden von _.ERASE _ALL ignoriert - deshalb
    ;; erst alle Layer auftauen, entsperren und einschalten.
    (command "_.LAYER" "_Thaw" "*" "_Unlock" "*" "_On" "*" "")
    (if (ssget "_X")
      (command "_.ERASE" "_ALL" "")
    )
    ;; PURGE mehrfach, da verschachtelte Block-Referenzen
    ;; erst nach mehreren Durchlaeufen entfernt werden
    (repeat 5
      (command "_.PURGE" "_ALL" "" "_N")
    )
    ;; Block-Library-Flag zuruecksetzen
    (setq *lib-initialized* nil)

    (if (findfile datei)
      (progn
        (load datei)
        ;; Test mit Fehlerbehandlung ausfuehren
        (setq test-result
          (vl-catch-all-apply
            '(lambda ()
              (eval (list (read (strcat "c:" befehl))))
            )
            nil
          )
        )
        (if (vl-catch-all-error-p test-result)
          (princ (strcat "\n  FEHLER in " befehl ": "
                         (vl-catch-all-error-message test-result)))
        )

        ;; JSON-Export (immer)
        (apply export-fn (list tests-out-dir))

        ;; Datei speichern je nach save-fmt aus alltests.json
        (setq out-path (strcat tests-out-dir "/" name "_tests"))
        (cond
          ((and save-fmt (= (strcase save-fmt) "DXF"))
            (command "_.DXFOUT" out-path 6)
            (princ (strcat "\n  DXF gespeichert: " out-path ".dxf"))
          )
          ((and save-fmt (= (strcase save-fmt) "DWG"))
            (command "_.-SAVEAS" "2013" (strcat out-path ".dwg"))
            (princ (strcat "\n  DWG gespeichert: " out-path ".dwg"))
          )
          (T
            (princ "\n  (kein Speichern der Zeichnung)")
          )
        )
      )
      (princ (strcat "\n  WARNUNG: " datei " nicht gefunden - uebersprungen"))
    )
  )

  (princ "\n\n================================================================")
  (princ "\n  SSG_RUN_ALL_TESTS abgeschlossen.")
  (princ (strcat "\n  Ergebnisse in: " (getenv "DXFMAKRO") "/tests/output/"))
  (princ "\n================================================================")
  (princ)
)