Testroutinen auf kseinaus umbenannt und aktualisiert
test_ks.lsp in test_kseinaus.lsp umbenannt und alle Testroutinen (foerderer, kreisel, omniflo) sowie run_tests.bat und README entsprechend angepasst.
This commit is contained in:
+171
-37
@@ -1,13 +1,17 @@
|
||||
;; ============================================================
|
||||
;; test_run_all.lsp - Fuehrt alle LISP-Tests nacheinander aus
|
||||
;;
|
||||
;; Laedt und startet:
|
||||
;; 1. TEST_KREISEL
|
||||
;; 2. TEST_FOERDERER
|
||||
;; 3. TEST_KSEINAUS
|
||||
;; 4. TEST_OMNIFLO_EXPORT
|
||||
;; 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 jeweils in tests/output/ gespeichert.
|
||||
;; 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
|
||||
@@ -18,49 +22,179 @@
|
||||
;; SSG_RUN_ALL_TESTS
|
||||
;; ============================================================
|
||||
|
||||
(defun c:SSG_RUN_ALL_TESTS ( / tests-pfad test-dateien test-befehle
|
||||
datei befehl idx anz)
|
||||
|
||||
(setq tests-pfad (strcat (getenv "DXFMAKRO") "/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)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Test-Dateien und zugehoerige Befehle
|
||||
(setq test-dateien (list
|
||||
(strcat tests-pfad "/test_kreisel.lsp")
|
||||
(strcat tests-pfad "/test_foerderer.lsp")
|
||||
(strcat tests-pfad "/test_ks.lsp")
|
||||
(strcat tests-pfad "/test_omniflo.lsp")
|
||||
))
|
||||
(setq test-befehle (list
|
||||
"TEST_KREISEL"
|
||||
"TEST_FOERDERER"
|
||||
"TEST_KSEINAUS"
|
||||
"TEST_OMNIFLO_EXPORT"
|
||||
))
|
||||
|
||||
(setq anz (length test-dateien))
|
||||
;; --- 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"))
|
||||
(princ (strcat "\n " (itoa anz) " Testmodule (aus alltests.json)"))
|
||||
(princ "\n================================================================")
|
||||
|
||||
;; Tests laden und ausfuehren
|
||||
(mapcar
|
||||
'(lambda (datei befehl)
|
||||
(setq idx (1+ idx))
|
||||
(princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " befehl " <<<"))
|
||||
(if (findfile datei)
|
||||
(progn
|
||||
(load datei)
|
||||
(eval (list (read (strcat "c:" befehl))))
|
||||
)
|
||||
(princ (strcat "\n WARNUNG: " datei " nicht gefunden - uebersprungen"))
|
||||
)
|
||||
;; 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
|
||||
(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"))
|
||||
)
|
||||
test-dateien
|
||||
test-befehle
|
||||
)
|
||||
|
||||
(princ "\n\n================================================================")
|
||||
|
||||
Reference in New Issue
Block a user