Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
be12533af1078413b0d806d72edc6c8198a94428
dxfmakros/tests/test_unit.lsp
T
m.stangl 3f7074f06b Lisp-Unit-Tests fuer reine Standardfunktionen + run_tests.bat --lisp 
- tests/test_unit.lsp: Mini-Test-Framework (tu-eq/tu-eqf/tu-true/tu-nil)
  und Testfaelle fuer reine Funktionen aus ssg_core, ssg_lang, ssg_id,
  vf_core, export, Gefaellestrecke, OmniModulInsert, KreiselInsert.
  Befehl TEST_UNIT schreibt tests/output/unit_results.txt.
- tests/test_unit.scr: Headless-Startskript (laedt SSG_LIB, ruft
  TEST_UNIT, beendet BricsCAD), pfadunabhaengig ueber DXFMAKRO.
- bin/run_tests.bat: Schalter --lisp startet BricsCAD headless, wertet
  den Report aus (RESULT: OK/FAIL) und setzt den Exit-Code.
- tests/README.md: Abschnitt zu den LISP-Unit-Tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-07-23 14:44:35 +02:00

384 lines
15 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_unit.lsp - Unit-Tests fuer einfache LISP-Standardfunktionen
;;
;; Testet reine Hilfsfunktionen (String, Zahl, Vektor, Liste,
;; Alist), die OHNE Zeichnungsdatenbank, Auswahlsaetze, Dialoge
;; oder Blockdateien auskommen - analog zu den Python-Unittests,
;; nur direkt in AutoLISP formuliert. Jeder Testfall vergleicht
;; einen Funktionsaufruf gegen ein erwartetes Ergebnis.
;;
;; Aufruf in BricsCAD (SSG_LIB muss geladen sein):
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
;; TEST_UNIT
;;
;; Ueber die Kommandozeile:
;; bin\run_tests.bat --lisp
;; (startet BricsCAD mit tests/output/_unit_run.scr, laedt SSG_LIB,
;; fuehrt TEST_UNIT aus und schreibt tests/output/unit_results.txt)
;;
;; Ergebnis:
;; Konsole: PASS/FAIL je Test + Zusammenfassung
;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen)
;; ============================================================
;; ------------------------------------------------------------
;; MINI-TEST-FRAMEWORK
;; ------------------------------------------------------------
(setq *tu-results* nil) ;; Liste von (pass-p name detail)
(setq *tu-pass* 0)
(setq *tu-fail* 0)
(defun tu-reset ()
(setq *tu-results* nil *tu-pass* 0 *tu-fail* 0)
)
(defun tu-str (v) (vl-princ-to-string v))
;; Ergebnis eines Testfalls erfassen
(defun tu-record (pass-p name detail)
(if pass-p
(setq *tu-pass* (1+ *tu-pass*))
(setq *tu-fail* (1+ *tu-fail*))
)
(setq *tu-results* (cons (list pass-p name detail) *tu-results*))
(princ (strcat "\n " (if pass-p "PASS" "FAIL") ": " name))
(if (not pass-p) (princ (strcat " | " detail)))
pass-p
)
;; Exakter Vergleich (Strings, Ganzzahlen, Listen von Strings/Ints)
(defun tu-eq (name expected actual)
(tu-record (equal expected actual) name
(strcat "erwartet=" (tu-str expected) " tatsaechlich=" (tu-str actual)))
)
;; Numerischer Vergleich mit Toleranz (Fliesskomma, auch verschachtelte Listen)
(defun tu-eqf (name expected actual)
(tu-record (equal expected actual 1e-6) name
(strcat "erwartet=" (tu-str expected) " tatsaechlich=" (tu-str actual)))
)
(defun tu-true (name actual)
(tu-record (not (null actual)) name (strcat "tatsaechlich=" (tu-str actual)))
)
(defun tu-nil (name actual)
(tu-record (null actual) name (strcat "tatsaechlich=" (tu-str actual)))
)
;; ------------------------------------------------------------
;; TESTS: ssg_core.lsp - String-/JSON-/Alist-Helfer
;; ------------------------------------------------------------
(defun tu-tests-core ()
(princ "\n[ssg_core]")
;; ssg-cfg-trim: Whitespace + abschliessendes Komma entfernen
(tu-eq "ssg-cfg-trim/spaces+komma" "hello" (ssg-cfg-trim " hello, "))
(tu-eq "ssg-cfg-trim/nur-spaces" "abc" (ssg-cfg-trim "\tabc\r\n"))
;; ssg-cfg-parse-value: JSON-Skalar erkennen
(tu-eq "ssg-cfg-parse-value/string" "text" (ssg-cfg-parse-value "\"text\""))
(tu-eq "ssg-cfg-parse-value/int" 42 (ssg-cfg-parse-value "42"))
(tu-eqf "ssg-cfg-parse-value/real" 3.5 (ssg-cfg-parse-value "3.5"))
(tu-true "ssg-cfg-parse-value/true" (ssg-cfg-parse-value "true"))
(tu-nil "ssg-cfg-parse-value/false" (ssg-cfg-parse-value "false"))
(tu-nil "ssg-cfg-parse-value/null" (ssg-cfg-parse-value "null"))
;; ssg-cfg-split-comma: an Kommas aufteilen
(tu-eq "ssg-cfg-split-comma" '("a" "b" "c") (ssg-cfg-split-comma "a,b,c"))
;; ssg-cfg-parse-array: JSON-Array parsen
(tu-eq "ssg-cfg-parse-array" '(1 2 3) (ssg-cfg-parse-array "[1, 2, 3]"))
;; ssg-cfg-parse-kv: "key": wert -> ("key" . wert)
(tu-eq "ssg-cfg-parse-kv" '("key" . 42) (ssg-cfg-parse-kv "\"key\": 42"))
;; ssg-val: Wert aus Alist lesen
(tu-eq "ssg-val/vorhanden" 2 (ssg-val '(("a" . 1) ("b" . 2)) "b"))
(tu-nil "ssg-val/fehlt" (ssg-val '(("a" . 1)) "x"))
;; ssg-attrib-defaults: (TAG DEFAULT) -> (TAG . DEFAULT)
(tu-eq "ssg-attrib-defaults"
'(("TYP" . "A") ("NR" . "0"))
(ssg-attrib-defaults '(("TYP" "A") ("NR" "0"))))
;; ssg-attrib-merge: gegebene Werte ueberschreiben Defaults
(tu-eq "ssg-attrib-merge/override"
'(("TYP" . "A") ("NR" . "5"))
(ssg-attrib-merge '(("NR" . "5")) '(("TYP" "A") ("NR" "0"))))
(tu-eq "ssg-attrib-merge/nil-given"
'(("TYP" . "A") ("NR" . "0"))
(ssg-attrib-merge nil '(("TYP" "A") ("NR" "0"))))
;; ssg-attrib-alist-to-defs: (TAG . Wert) -> (TAG Wert)
(tu-eq "ssg-attrib-alist-to-defs"
'(("TYP" "A") ("NR" "0"))
(ssg-attrib-alist-to-defs '(("TYP" . "A") ("NR" . "0"))))
;; ssg-geruest-typ-to-idx / idx-to-typ (Combobox-Zuordnung)
(tu-eq "ssg-geruest-typ-to-idx/bekannt" 2 (ssg-geruest-typ-to-idx "Schoenenberger Geruest"))
(tu-eq "ssg-geruest-typ-to-idx/erst" 0 (ssg-geruest-typ-to-idx "IPE-Geruest abgestuft"))
(tu-eq "ssg-geruest-typ-to-idx/unbekannt" 2 (ssg-geruest-typ-to-idx "gibtsnicht"))
(tu-eq "ssg-geruest-idx-to-typ" "Schoenenberger Geruest" (ssg-geruest-idx-to-typ 2))
;; ssg-ini-* : INI-Parser (Eingabe = Zeilenliste, kein Datei-IO)
(setq _ini (ssg-ini-parse-lines
'("# Kommentar" "[sek]" "key = wert" "liste = a, b ,c")))
(tu-eq "ssg-ini-get/vorhanden" "wert" (ssg-ini-get _ini "sek" "key" "def"))
(tu-eq "ssg-ini-get/default" "def" (ssg-ini-get _ini "sek" "fehlt" "def"))
(tu-eq "ssg-ini-list/normalisiert" "a,b,c" (ssg-ini-list _ini "sek" "liste" "x"))
;; ssg-parse-json-array: flaches JSON-Array -> Liste von Alists
(tu-eq "ssg-parse-json-array"
'((("a" . 1) ("b" . 2)))
(ssg-parse-json-array '("[" "{" "\"a\": 1," "\"b\": 2" "}" "]")))
)
;; ------------------------------------------------------------
;; TESTS: ssg_lang.lsp - Textersetzung
;; ------------------------------------------------------------
(defun tu-tests-lang ()
(princ "\n[ssg_lang]")
;; ssg-str-replace-all: (neu alt str)
(tu-eq "ssg-str-replace-all/alle" "fXX" (ssg-str-replace-all "X" "o" "foo"))
(tu-eq "ssg-str-replace-all/mehrfach" "a-b-c" (ssg-str-replace-all "-" "." "a.b.c"))
(tu-eq "ssg-str-replace-all/keins" "abc" (ssg-str-replace-all "X" "z" "abc"))
;; ssg-lang-unescape: literales \n (Backslash+n) -> echter Zeilenumbruch
(setq _u (ssg-lang-unescape (strcat "a" "\\n" "b")))
(tu-eq "ssg-lang-unescape/laenge" 3 (strlen _u))
(tu-eq "ssg-lang-unescape/newline" (chr 10) (substr _u 2 1))
)
;; ------------------------------------------------------------
;; TESTS: ssg_id.lsp - ID-Formatierung
;; ------------------------------------------------------------
(defun tu-tests-id ()
(princ "\n[ssg_id]")
(tu-eq "ssg-id-format/1" "0001" (ssg-id-format 1))
(tu-eq "ssg-id-format/42" "0042" (ssg-id-format 42))
(tu-eq "ssg-id-format/1000" "1000" (ssg-id-format 1000))
(tu-eq "ssg-id-format/12345" "12345" (ssg-id-format 12345))
)
;; ------------------------------------------------------------
;; TESTS: vf_core.lsp - Vektor-/Frame-Mathematik
;; ------------------------------------------------------------
(defun tu-tests-vfcore ()
(princ "\n[vf_core]")
(tu-eqf "vec-length/3-4-0" 5.0 (vec-length '(3.0 4.0 0.0)))
(tu-eqf "vec3-cross/x-cross-y" '(0.0 0.0 1.0) (vec3-cross '(1.0 0.0 0.0) '(0.0 1.0 0.0)))
(tu-eqf "vec3-cross/z-cross-x" '(0.0 1.0 0.0) (vec3-cross '(0.0 0.0 1.0) '(1.0 0.0 0.0)))
(tu-eqf "vec3-normalize/z5" '(0.0 0.0 1.0) (vec3-normalize '(0.0 0.0 5.0)))
(tu-eqf "mat3-mul-vec3/identitaet"
'(2.0 3.0 4.0)
(mat3-mul-vec3 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) '(2.0 3.0 4.0)))
(tu-eqf "punkt-differenz" '(3.0 4.0 5.0) (punkt-differenz '(1.0 1.0 1.0) '(4.0 5.0 6.0)))
(tu-eq "ks-normalize-name/ksys-ein" "KS_EIN" (ks-normalize-name "KSYS_EIN"))
(tu-eq "ks-normalize-name/ks-aus" "KS_AUS" (ks-normalize-name "KS_AUS"))
(tu-nil "ks-normalize-name/kein-ks" (ks-normalize-name "IRGENDWAS"))
(tu-eq "ks-line-axis/X-1" "X" (ks-line-axis 1.0))
(tu-eq "ks-line-axis/X-100" "X" (ks-line-axis 100.0))
(tu-eq "ks-line-axis/Y" "Y" (ks-line-axis 2.0))
(tu-eq "ks-line-axis/Z" "Z" (ks-line-axis 3.0))
(tu-eq "fmt/zahl" "3.14" (fmt 3.14159))
(tu-eq "fmt/nil" "---" (fmt nil))
;; hz-winkel->xu: Richtungsvektor aus Horizontal-/Vertikalwinkel
(tu-eqf "hz-winkel->xu/0-0" '(1.0 0.0 0.0) (hz-winkel->xu 0 0))
(tu-eqf "hz-winkel->xu/90-0" '(0.0 1.0 0.0) (hz-winkel->xu 90 0))
;; Roundtrip frame -> (hz winkel)
(tu-eqf "frame->hz-winkel/roundtrip"
'(30.0 10.0)
(frame->hz-winkel (punkt-hz-winkel->frame '(0.0 0.0 0.0) 30 10)))
;; ks-relativize / ks-absolutize sind zueinander invers
(setq _ks '(("KS_EIN" ((100.0 200.0 300.0) (101.0 200.0 300.0)))))
(tu-eqf "ks-relativize+absolutize/invers"
_ks
(ks-absolutize (ks-relativize _ks '(10.0 20.0 30.0)) '(10.0 20.0 30.0)))
)
;; ------------------------------------------------------------
;; TESTS: export.lsp - CSV/KOS-Kodierung
;; ------------------------------------------------------------
(defun tu-tests-export ()
(princ "\n[export]")
(tu-eq "csv:clamp/innen" 5 (csv:clamp 5 0 10))
(tu-eq "csv:clamp/unten" 0 (csv:clamp -3 0 10))
(tu-eq "csv:clamp/oben" 10 (csv:clamp 20 0 10))
(tu-eqf "csv:z-angle-to-quat/0" '(0.0 0.0 0.0 1.0) (csv:z-angle-to-quat 0))
(tu-eqf "csv:z-angle-to-quat/180" '(0.0 0.0 1.0 0.0) (csv:z-angle-to-quat 180))
(tu-eq "csv:b64-encode-ints/0" "AAAA" (csv:b64-encode-ints '(0)))
(tu-eq "csv:trans-encode/0-0-0" "AAAAAAAAAAAA" (csv:trans-encode 0.0 0.0 0.0))
;; local-to-world: reine Z-Drehung um den Elternpunkt
(tu-eqf "csv:local-to-world/keine-drehung"
'(1.0 0.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) 0.0 '(1.0 0.0 0.0)))
(tu-eqf "csv:local-to-world/90-grad"
'(0.0 1.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (/ pi 2.0) '(1.0 0.0 0.0)))
;; json-escape: Anfuehrungszeichen maskieren
(tu-eq "csv:json-escape/quote" "a\\\"b" (csv:json-escape "a\"b"))
)
;; ------------------------------------------------------------
;; TESTS: Gefaellestrecke.lsp - Geometrie-/Listen-Helfer
;; ------------------------------------------------------------
(defun tu-tests-gf ()
(princ "\n[Gefaellestrecke]")
(tu-eq "gf-snap-bogenwinkel/30" 30 (gf-snap-bogenwinkel 30))
(tu-eq "gf-snap-bogenwinkel/44" 30 (gf-snap-bogenwinkel 44))
(tu-eq "gf-snap-bogenwinkel/60" 60 (gf-snap-bogenwinkel 60))
(tu-eq "gf-snap-bogenwinkel/90" 90 (gf-snap-bogenwinkel 90))
(tu-eq "gf-bogen-blockname"
"Gefaellebogen_links_90_R500" (gf-bogen-blockname 90 "links"))
(tu-eqf "gf-abstand-2d/3-4" 5.0 (gf-abstand-2d '(0.0 0.0) '(3.0 4.0)))
(tu-eqf "gf-hz-winkel/rechts" 0.0 (gf-hz-winkel '(0.0 0.0) '(1.0 0.0)))
(tu-eqf "gf-hz-winkel/oben" 90.0 (gf-hz-winkel '(0.0 0.0) '(0.0 1.0)))
(tu-eq "gf-replace-nth" '(a x c) (gf-replace-nth '(a b c) 1 'x))
;; gf-exit-hz: Ausgangsrichtung nach letztem Segment
(tu-eqf "gf-exit-hz/linie" 45.0 (gf-exit-hz '(("Linie" 45.0))))
(tu-eqf "gf-exit-hz/bogen-links"
90.0 (gf-exit-hz '(("Linie" 0.0) ("Bogen" 0.0 nil 90 "links"))))
)
;; ------------------------------------------------------------
;; TESTS: OmniModulInsert.lsp - Datensatz-Helfer
;; ------------------------------------------------------------
(defun tu-tests-omni ()
(princ "\n[OmniModulInsert]")
(tu-eq "omni:sivasid-to-str/int" "42" (omni:sivasid-to-str 42))
(tu-eq "omni:sivasid-to-str/str" "abc" (omni:sivasid-to-str "abc"))
(tu-eq "omni:sivasid-to-str/real" "3" (omni:sivasid-to-str 3.0))
;; Mock-Datensatz (Struktur wie ssg-load-json liefern wuerde)
(setq _lst
'((("Sivasnr" . 100) ("KurvenWinkel" . 45) ("Radius" . 550))
(("Sivasnr" . 200) ("KurvenWinkel" . 90) ("Radius" . 400))
(("Sivasnr" . 300) ("KurvenWinkel" . 45) ("Radius" . 750))))
(tu-eq "omni:val" 400 (omni:val (omni:get-by-sivasid _lst 200) "Radius"))
(tu-nil "omni:get-by-sivasid/fehlt" (omni:get-by-sivasid _lst 999))
(tu-eq "omni:filter/anzahl" 2 (length (omni:filter _lst "KurvenWinkel" 45)))
(tu-eq "omni:filter/wert"
100 (cdr (assoc "Sivasnr" (car (omni:filter _lst "KurvenWinkel" 45)))))
)
;; ------------------------------------------------------------
;; TESTS: KreiselInsert.lsp - Geometrie-Helfer
;; ------------------------------------------------------------
(defun tu-tests-kreisel ()
(princ "\n[KreiselInsert]")
;; Projektion eines Punktes auf eine Gerade
(tu-eqf "kreisel-project-point/lot"
'(0.0 0.0) (kreisel-project-point '(0.0 5.0) '(0.0 0.0) '(10.0 0.0)))
(tu-eqf "kreisel-project-point/mitte"
'(5.0 0.0) (kreisel-project-point '(5.0 5.0) '(0.0 0.0) '(10.0 0.0)))
;; Parallelitaet zweier Richtungsvektoren
(tu-true "kreisel-parallel-p/parallel" (kreisel-parallel-p '(1.0 0.0) '(2.0 0.0)))
(tu-nil "kreisel-parallel-p/senkrecht" (kreisel-parallel-p '(1.0 0.0) '(0.0 1.0)))
;; Ausrichtung <-> Index
(tu-eqf "kreisel-idx-to-rotation/0" 0.0 (kreisel-idx-to-rotation 0))
(tu-eqf "kreisel-idx-to-rotation/2" 90.0 (kreisel-idx-to-rotation 2))
(tu-eq "kreisel-rotation-to-idx/90" 2 (kreisel-rotation-to-idx 90.0))
(tu-eq "kreisel-rotation-to-idx/180" 1 (kreisel-rotation-to-idx 180.0))
)
;; ------------------------------------------------------------
;; REPORT SCHREIBEN
;; ------------------------------------------------------------
(defun tu-write-report (pfad / f res)
(setq f (open pfad "w"))
(if f
(progn
(write-line "# SSG_LIB LISP Unit-Test Report" f)
(foreach res (reverse *tu-results*)
(write-line
(strcat (if (car res) "PASS: " "FAIL: ") (cadr res)
(if (car res) "" (strcat " | " (caddr res))))
f))
(write-line (strcat "SUMMARY: total=" (itoa (+ *tu-pass* *tu-fail*))
" passed=" (itoa *tu-pass*)
" failed=" (itoa *tu-fail*)) f)
(write-line (if (= *tu-fail* 0) "RESULT: OK" "RESULT: FAIL") f)
(close f)
T
)
nil
)
)
;; ------------------------------------------------------------
;; BEFEHL: TEST_UNIT
;; ------------------------------------------------------------
(defun c:TEST_UNIT ( / out-dir report)
(tu-reset)
(princ "\n================================================================")
(princ "\n TEST_UNIT - LISP-Standardfunktionen")
(princ "\n================================================================")
(tu-tests-core)
(tu-tests-lang)
(tu-tests-id)
(tu-tests-vfcore)
(tu-tests-export)
(tu-tests-gf)
(tu-tests-omni)
(tu-tests-kreisel)
(princ "\n\n----------------------------------------------------------------")
(princ (strcat "\n Gesamt: " (itoa (+ *tu-pass* *tu-fail*))
" | PASS: " (itoa *tu-pass*)
" | FAIL: " (itoa *tu-fail*)))
(princ (if (= *tu-fail* 0) "\n ERGEBNIS: ALLE TESTS BESTANDEN" "\n ERGEBNIS: TESTS FEHLGESCHLAGEN"))
(princ "\n----------------------------------------------------------------")
;; Report-Datei schreiben (fuer run_tests.bat --lisp)
(setq out-dir (strcat (getenv "DXFMAKRO") "/tests/output"))
(vl-mkdir out-dir)
(setq report (strcat out-dir "/unit_results.txt"))
(if (tu-write-report report)
(princ (strcat "\n Report: " report))
(princ "\n WARNUNG: Report konnte nicht geschrieben werden.")
)
(princ)
)
(princ "\ntest_unit.lsp geladen. Befehl: TEST_UNIT")
(princ)
Reference in New Issue View Git Blame Copy Permalink