;; ============================================================ ;; test_run_all.lsp - Fuehrt alle LISP-Tests nacheinander aus ;; ;; Laedt und startet alle in tests/alltests.json registrierten Tests. ;; Konvention: Aus Basisname leiten sich ab: ;; Datei: test_.lsp ;; Befehl: TEST_ ;; Export: :export-results ;; ;; Ergebnisse werden in tests/output/ gespeichert: ;; JSON: immer (_results.json, via :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) )