752 lines
32 KiB
Common Lisp
752 lines
32 KiB
Common Lisp
;; ============================================================
|
|
;; 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" "}" "]")))
|
|
|
|
;; ssg-layer-cfg-eintrag: "Layername, Farbe" -> (layer . farbe)
|
|
;; Reine Funktion, ini-Daten als Parameter - kein Datei-IO, keine Zeichnung.
|
|
(setq _lay (ssg-ini-parse-lines
|
|
'("# Kommentar"
|
|
"[ils_2d]"
|
|
"variofoerderer = ILS_Fingerfoerderer, 4"
|
|
"ohne_farbe = ILS_SP"
|
|
"leer ="
|
|
"[ils_3d]"
|
|
"variofoerderer = _3D_ILS_Fingerfoerderer, 4"
|
|
"[allgemein]"
|
|
"vf_beschriftung = VF_Beschriftung, 7")))
|
|
(tu-eq "ssg-layer-cfg-eintrag/layer-und-farbe"
|
|
'("ILS_Fingerfoerderer" . "4")
|
|
(ssg-layer-cfg-eintrag _lay "ils_2d" "variofoerderer"))
|
|
(tu-eq "ssg-layer-cfg-eintrag/ohne-farbe-default-7"
|
|
'("ILS_SP" . "7")
|
|
(ssg-layer-cfg-eintrag _lay "ils_2d" "ohne_farbe"))
|
|
(tu-nil "ssg-layer-cfg-eintrag/leerer-wert"
|
|
(ssg-layer-cfg-eintrag _lay "ils_2d" "leer"))
|
|
(tu-nil "ssg-layer-cfg-eintrag/key-fehlt"
|
|
(ssg-layer-cfg-eintrag _lay "ils_2d" "gibtsnicht"))
|
|
(tu-nil "ssg-layer-cfg-eintrag/sektion-fehlt"
|
|
(ssg-layer-cfg-eintrag _lay "gibtsnicht" "variofoerderer"))
|
|
|
|
;; ssg-layer-eintrag: Aufloesung [ils_<dim>] -> [allgemein].
|
|
;; Dimension und cfg werden hier injiziert (kein Datei-IO); der gemerkte
|
|
;; Ladeversuch verhindert, dass ssg-layer-cfg-load die echte Datei liest.
|
|
(setq _lay-cfg-alt *ssg-layer-cfg*
|
|
_lay-vers-alt *ssg-layer-cfg-versucht*
|
|
_lay-dim-alt (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
|
|
(setq *ssg-layer-cfg* _lay *ssg-layer-cfg-versucht* T)
|
|
(setq *ssg-ils-dim* "2D")
|
|
(tu-eq "ssg-layer-eintrag/dim-2d"
|
|
'("ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
|
|
(tu-eq "ssg-layer-eintrag/fallback-allgemein"
|
|
'("VF_Beschriftung" . "7") (ssg-layer-eintrag "vf_beschriftung"))
|
|
(setq *ssg-ils-dim* "3D")
|
|
(tu-eq "ssg-layer-eintrag/dim-3d"
|
|
'("_3D_ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
|
|
(tu-nil "ssg-layer-eintrag/unbekannte-baugruppe"
|
|
(ssg-layer-eintrag "gibtsnicht"))
|
|
|
|
;; ssg-layer-farbe-fuer-name: Farbe zu einem LAYERNAMEN (nicht Baugruppe).
|
|
;; Wird gebraucht, weil Layer aus dem LAYER-Attribut oft VOR dem Wrapper
|
|
;; angelegt werden und ssg-make-layer die Farbe nur bei Neuanlage setzt.
|
|
(setq *ssg-layer-cfg* (ssg-ini-parse-lines
|
|
'("[ils_3d]"
|
|
"gefaellestrecke = _3D_ILS_SP, 3"
|
|
"[allgemein]"
|
|
"vf_beschriftung = VF_Beschriftung, 7"
|
|
"[farben]"
|
|
"ILS_SEP-SP = 82")))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/abschnitt-farben"
|
|
"82" (ssg-layer-farbe-fuer-name "ILS_SEP-SP"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/aus-baugruppen-wert"
|
|
"3" (ssg-layer-farbe-fuer-name "_3D_ILS_SP"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/case-insensitiv"
|
|
"3" (ssg-layer-farbe-fuer-name "_3d_ils_sp"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/unbekannt-default-7"
|
|
"7" (ssg-layer-farbe-fuer-name "GibtsNicht"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/leerer-name"
|
|
"7" (ssg-layer-farbe-fuer-name ""))
|
|
;; Globale Zustaende wieder herstellen
|
|
(setq *ssg-ils-dim* _lay-dim-alt
|
|
*ssg-layer-cfg* _lay-cfg-alt
|
|
*ssg-layer-cfg-versucht* _lay-vers-alt)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: ssg_ks_insert.lsp - Sepliste-Serialisierung
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-sepliste ()
|
|
(princ "\n[ssg_ks_insert/sepliste]")
|
|
|
|
;; ssg-sepliste-chunk-string: Stuecke <= n, nichts verloren
|
|
(tu-eq "ssg-sepliste-chunk-string/glatt" '("ab" "cd") (ssg-sepliste-chunk-string "abcd" 2))
|
|
(tu-eq "ssg-sepliste-chunk-string/rest" '("ab" "cd" "e") (ssg-sepliste-chunk-string "abcde" 2))
|
|
(tu-eq "ssg-sepliste-chunk-string/kuerzer" '("abc") (ssg-sepliste-chunk-string "abc" 10))
|
|
|
|
;; ssg-sepliste-split-feld: Trenner-Aufteilung, inkl. leeres Feld
|
|
(tu-eq "ssg-sepliste-split-feld/normal" '("SEP" "1" "10.00" "20.00")
|
|
(ssg-sepliste-split-feld "SEP:1:10.00:20.00" ":"))
|
|
|
|
;; ssg-sepliste->string: Serialisierung eines Eintrags
|
|
(tu-eq "ssg-sepliste->string/ein-eintrag"
|
|
"SEP:1:10.00:20.00"
|
|
(ssg-sepliste->string '(("SEP" 1 10.0 20.0))))
|
|
(tu-eq "ssg-sepliste->string/mehrere"
|
|
"SEP:1:10.00:20.00,AS:2:30.00:40.00"
|
|
(ssg-sepliste->string '(("SEP" 1 10.0 20.0) ("AS" 2 30.0 40.0))))
|
|
|
|
;; ssg-sepliste-string->liste: Gegenstueck zu ssg-sepliste->string
|
|
(tu-eq "ssg-sepliste-string->liste/leer" nil (ssg-sepliste-string->liste ""))
|
|
(tu-eq "ssg-sepliste-string->liste/ein-eintrag"
|
|
'(("SEP" 1 10.0 20.0))
|
|
(ssg-sepliste-string->liste "SEP:1:10.00:20.00"))
|
|
|
|
;; Roundtrip ->string->liste: entscheidend, da der Export genau diesen
|
|
;; Weg (XDATA schreiben/lesen) fuer die Separator-Reihenfolge nutzt.
|
|
(setq _sep '(("SEP" 1 10.0 20.0) ("AS" 2 30.5 40.5) ("ES" 3 -5.0 0.0)))
|
|
(tu-eqf "sepliste-roundtrip/mehrere-typen"
|
|
_sep
|
|
(ssg-sepliste-string->liste (ssg-sepliste->string _sep)))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: ssg_core.lsp - rekursiver JSON-Parser + ssg-join
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-json ( / _p _datei _daten _bg _var _anb)
|
|
(princ "\n[ssg_core/json]")
|
|
|
|
;; ssg-join
|
|
(tu-eq "ssg-join/leer" "" (ssg-join '() ","))
|
|
(tu-eq "ssg-join/eins" "a" (ssg-join '("a") ","))
|
|
(tu-eq "ssg-join/drei" "a,b,c" (ssg-join '("a" "b" "c") ","))
|
|
(tu-eq "ssg-join/plus" "a + b" (ssg-join '("a" "b") " + "))
|
|
|
|
;; Skalare und flaches Objekt
|
|
(tu-eq "json/objekt-flach" '(("a" . 1)) (ssg-json-parse "{\"a\": 1}"))
|
|
(tu-eq "json/zwei-keys" '(("a" . 1) ("b" . 2))
|
|
(ssg-json-parse "{\"a\": 1, \"b\": 2}"))
|
|
(tu-eq "json/string" "hallo" (ssg-json-get (ssg-json-parse "{\"a\": \"hallo\"}") "a"))
|
|
(tu-eq "json/int" 6000 (ssg-json-get (ssg-json-parse "{\"a\": 6000}") "a"))
|
|
(tu-eqf "json/real" 1.5 (ssg-json-get (ssg-json-parse "{\"a\": 1.5}") "a"))
|
|
(tu-eq "json/true" T (ssg-json-get (ssg-json-parse "{\"a\": true}") "a"))
|
|
(tu-eq "json/false" nil (ssg-json-get (ssg-json-parse "{\"a\": false}") "a"))
|
|
(tu-eq "json/null" nil (ssg-json-get (ssg-json-parse "{\"a\": null}") "a"))
|
|
|
|
;; Verschachtelung - genau das, was die alten Zeilen-Parser nicht koennen
|
|
(tu-eq "json/objekt-verschachtelt" '(("a" ("b" . 2)))
|
|
(ssg-json-parse "{\"a\": {\"b\": 2}}"))
|
|
(tu-eq "json/array" '(("a" 1 2 3))
|
|
(ssg-json-parse "{\"a\": [1, 2, 3]}"))
|
|
(tu-eq "json/array-objekte" '(("a" (("b" . 1)) (("b" . 2))))
|
|
(ssg-json-parse "{\"a\": [{\"b\": 1}, {\"b\": 2}]}"))
|
|
(tu-eq "json/array-leer" '(("a")) (ssg-json-parse "{\"a\": []}"))
|
|
|
|
;; Mehrzeilig (alte Parser verlangen Arrays in EINER Zeile)
|
|
(tu-eq "json/mehrzeilig" '(("a" "x" "y"))
|
|
(ssg-json-parse "{\n \"a\": [\n \"x\",\n \"y\"\n ]\n}"))
|
|
|
|
;; Maskiertes Anfuehrungszeichen und Komma im String - beides kommt in den
|
|
;; Geruest-Artikelbezeichnungen real vor ("ROHR R 1\" 33,7 x 2,6")
|
|
(tu-eq "json/escape-quote" "R 1\" x"
|
|
(ssg-json-get (ssg-json-parse "{\"a\": \"R 1\\\" x\"}") "a"))
|
|
(tu-eq "json/komma-im-string" "33,7 x 2,6"
|
|
(ssg-json-get (ssg-json-parse "{\"a\": \"33,7 x 2,6\"}") "a"))
|
|
(tu-eq "json/escape-backslash" "a\\b"
|
|
(ssg-json-get (ssg-json-parse "{\"a\": \"a\\\\b\"}") "a"))
|
|
(tu-eq "json/escape-newline" (chr 10)
|
|
(ssg-json-get (ssg-json-parse "{\"a\": \"\\n\"}") "a"))
|
|
|
|
;; ssg-json-escape: Gegenstueck zum Parser
|
|
(tu-eq "json-escape/quote" "a\\\"b" (ssg-json-escape "a\"b"))
|
|
(tu-eq "json-escape/backslash" "a\\\\b" (ssg-json-escape "a\\b"))
|
|
(tu-eq "json-escape/newline" "a\\nb" (ssg-json-escape (strcat "a" (chr 10) "b")))
|
|
(tu-eq "json-escape/leer" "" (ssg-json-escape nil))
|
|
;; Rundlauf: maskieren -> parsen ergibt den Originaltext zurueck
|
|
(tu-eq "json-escape/rundlauf" "ROHRKLAMMER 1\" KPL. VERTIKAL"
|
|
(ssg-json-get
|
|
(ssg-json-parse
|
|
(strcat "{\"a\": \""
|
|
(ssg-json-escape "ROHRKLAMMER 1\" KPL. VERTIKAL") "\"}"))
|
|
"a"))
|
|
|
|
;; Echte Datendatei: der eigentliche Praxisfall
|
|
(setq _datei (strcat (getenv "DXFMAKRO") "/data/json/geruest.json"))
|
|
(if (findfile _datei)
|
|
(progn
|
|
(setq _daten (ssg-json-laden _datei))
|
|
;; Drei Bereiche: Rohrabhaenger, Saeulen (1 und 2 Zoll zusammengefuehrt),
|
|
;; Wandbefestigung
|
|
(tu-eq "json/geruest-baugruppen" 3 (length _daten))
|
|
;; Baugruppe ueber das ASCII-Feld "id" finden (aeusserer Schluessel
|
|
;; traegt Umlaute bzw. Anfuehrungszeichen)
|
|
(setq _bg nil)
|
|
(foreach _e _daten
|
|
(if (and (null _bg) (= (ssg-json-get (cdr _e) "id") "Rohrabhaenger"))
|
|
(setq _bg (cdr _e))))
|
|
(tu-eq "json/geruest-id-gefunden" T (if _bg T nil))
|
|
(if _bg
|
|
(progn
|
|
(setq _var (ssg-json-get _bg "geometrie_varianten"))
|
|
(setq _anb (ssg-json-get _bg "anbaugruppen"))
|
|
(tu-eq "json/geruest-varianten" 3 (length _var))
|
|
(tu-eq "json/geruest-teileart" "Geruest Rohrabhaenger"
|
|
(ssg-json-get _bg "teileart"))
|
|
(tu-eq "json/geruest-dummy" "Rohrabhaenger_dummy.dwg"
|
|
(ssg-json-get _bg "dummy"))
|
|
;; Sivas-ID als Zahl geparst, Laengengrenze aus dem attribute-Block
|
|
(tu-eq "json/geruest-sivas" 821006026
|
|
(ssg-json-get (car (ssg-json-get (car _var) "teile")) "sivas_id"))
|
|
(tu-eq "json/geruest-max" 6000
|
|
(ssg-json-get (ssg-json-get (ssg-json-get _bg "attribute") "Laenge") "max"))
|
|
)
|
|
)
|
|
)
|
|
(tu-record nil "json/geruest-datei" (strcat "nicht gefunden: " _datei))
|
|
)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: GeruestInsert.lsp - reine Hilfsfunktionen
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-geruest ( / _eintrag _gruppe _teile _konfig _rec _pfad _f
|
|
_zurueck _bgtest _saeulen)
|
|
(princ "\n[GeruestInsert]")
|
|
(if (and (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN")))
|
|
(atoms-family 1 '("SSG-ENSURE")))
|
|
(ssg-ensure "GeruestInsert")
|
|
)
|
|
(if (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN")))
|
|
(tu-record nil "geruest/modul" "GeruestInsert.lsp nicht geladen")
|
|
(progn
|
|
(tu-eq "geruest-id-string/int" "821006026" (geruest-id-string 821006026))
|
|
(tu-eq "geruest-id-string/str" "0_B10071" (geruest-id-string "0_B10071"))
|
|
(tu-eq "geruest-id-string/nil" nil (geruest-id-string nil))
|
|
|
|
;; Einzelteil mit menge 2 -> Artikelnummer zweimal (ARTINR-Regel)
|
|
(setq _eintrag (ssg-json-parse
|
|
"{\"artikel\": \"X\", \"sivas_id\": 825002019, \"menge\": 2}"))
|
|
(tu-eq "geruest-artnr/menge2" '("825002019" "825002019")
|
|
(geruest-artikelnummern _eintrag))
|
|
(tu-eq "geruest-name/artikel" "X" (geruest-eintrag-name _eintrag))
|
|
|
|
;; Benannte Gruppe -> teile rekursiv aufloesen, Mengen beachten
|
|
(setq _gruppe (ssg-json-parse
|
|
(strcat "{\"name\": \"Schraubenset\", \"teile\": ["
|
|
"{\"artikel\": \"A\", \"sivas_id\": 111, \"menge\": 1},"
|
|
"{\"artikel\": \"B\", \"sivas_id\": 222, \"menge\": 2}]}")))
|
|
(tu-eq "geruest-artnr/gruppe" '("111" "222" "222")
|
|
(geruest-artikelnummern _gruppe))
|
|
(tu-eq "geruest-name/gruppe" "Schraubenset" (geruest-eintrag-name _gruppe))
|
|
|
|
;; Fehlendes menge-Feld -> 1
|
|
(tu-eq "geruest-artnr/ohne-menge" '("333")
|
|
(geruest-artikelnummern
|
|
(ssg-json-parse "{\"artikel\": \"C\", \"sivas_id\": 333}")))
|
|
|
|
;; --- Mengenfeld ---
|
|
(tu-eq "geruest-zahl-p/ziffern" T (geruest-zahl-p "12"))
|
|
(tu-eq "geruest-zahl-p/text" nil (geruest-zahl-p "1a"))
|
|
(tu-eq "geruest-zahl-p/leer" nil (geruest-zahl-p ""))
|
|
;; Leeres Feld uebernimmt die JSON-Vorgabe, ungueltiges liefert nil
|
|
(tu-eq "geruest-menge-wert/leer" 2 (geruest-menge-wert "" 2))
|
|
(tu-eq "geruest-menge-wert/zahl" 5 (geruest-menge-wert "5" 2))
|
|
(tu-eq "geruest-menge-wert/null" nil (geruest-menge-wert "0" 2))
|
|
(tu-eq "geruest-menge-wert/text" nil (geruest-menge-wert "abc" 2))
|
|
(tu-eq "geruest-menge-wert/negativ" nil (geruest-menge-wert "-3" 2))
|
|
|
|
;; --- Stueckzahl ersetzt die JSON-Menge (Einzelteil) ---
|
|
(tu-eq "geruest-artnr-n/einzelteil" '("825002019" "825002019" "825002019")
|
|
(geruest-artikelnummern-n _eintrag 3))
|
|
;; --- Gruppe: ganzes Set n-mal, Mengen INNERHALB bleiben erhalten ---
|
|
(tu-eq "geruest-artnr-n/gruppe" '("111" "222" "222" "111" "222" "222")
|
|
(geruest-artikelnummern-n _gruppe 2))
|
|
|
|
;; --- DCL-Label: Anfuehrungszeichen wuerde die Datei zerstoeren ---
|
|
(tu-eq "geruest-dcl-label/quote" "ROHRKLAMMER 1'' KPL. VERTIKAL"
|
|
(geruest-dcl-label "ROHRKLAMMER 1\" KPL. VERTIKAL"))
|
|
(tu-eq "geruest-dcl-label/ohne" "WINKEL 60X60X6X60"
|
|
(geruest-dcl-label "WINKEL 60X60X6X60"))
|
|
|
|
;; --- Hilfslisten ---
|
|
(tu-eq "geruest-nil-liste" '(nil nil nil) (geruest-nil-liste 3))
|
|
(tu-eq "geruest-liste-setzen" '(nil 7 nil)
|
|
(geruest-liste-setzen (geruest-nil-liste 3) 1 7))
|
|
(tu-eq "geruest-alist-setzen/neu" '(("a" . 1))
|
|
(geruest-alist-setzen nil "a" 1))
|
|
(tu-eq "geruest-alist-setzen/ersetzt" '(("a" . 2))
|
|
(geruest-alist-setzen '(("a" . 1)) "a" 2))
|
|
(tu-eq "geruest-zahl-string/int" "2000" (geruest-zahl-string 2000))
|
|
(tu-eq "geruest-zahl-string/leer" "" (geruest-zahl-string nil))
|
|
|
|
;; --- Konfiguration auf Anbauteile abbilden ---
|
|
(setq _teile (list _eintrag _gruppe))
|
|
(tu-eq "geruest-name-index/treffer" 1
|
|
(geruest-name-index "Schraubenset" _teile))
|
|
(tu-eq "geruest-name-index/fehlt" nil
|
|
(geruest-name-index "gibt es nicht" _teile))
|
|
;; Bekanntes Teil wird uebernommen, unbekanntes uebersprungen (nicht
|
|
;; die ganze Konfiguration verworfen)
|
|
(setq _konfig (ssg-json-parse
|
|
(strcat "{\"name\": \"K1\", \"oben\": ["
|
|
"{\"artikel\": \"Schraubenset\", \"menge\": 3},"
|
|
"{\"artikel\": \"unbekannt\", \"menge\": 1}]}")))
|
|
(tu-eq "geruest-konfig-position" '(nil 3)
|
|
(geruest-konfig-position _konfig "oben" _teile))
|
|
|
|
;; --- Variante gewinnt vor Baugruppe (TEILEART/dummy) ---
|
|
;; Die zusammengefuehrte Saeulen-Baugruppe unterscheidet 1 Zoll und
|
|
;; 2 Zoll nur noch ueber das teileart-Feld der Variante.
|
|
(setq _bgtest (ssg-json-parse
|
|
"{\"teileart\": \"Basis\", \"dummy\": \"basis.dwg\"}"))
|
|
(tu-eq "geruest-variante-wert/variante-gewinnt" "Speziell"
|
|
(geruest-variante-wert
|
|
(ssg-json-parse "{\"teileart\": \"Speziell\"}") _bgtest "teileart"))
|
|
(tu-eq "geruest-variante-wert/rueckfall" "Basis"
|
|
(geruest-variante-wert
|
|
(ssg-json-parse "{\"name\": \"X\"}") _bgtest "teileart"))
|
|
(tu-eq "geruest-variante-wert/ohne-variante" "basis.dwg"
|
|
(geruest-variante-wert nil _bgtest "dummy"))
|
|
|
|
;; --- Zusammengefuehrte Saeulen-Baugruppe ---
|
|
(setq _saeulen nil)
|
|
(foreach _e (geruest-baugruppen-liste)
|
|
(if (equal (car _e) "Saeulen") (setq _saeulen (cdr _e))))
|
|
(tu-eq "geruest/saeulen-vorhanden" T (if _saeulen T nil))
|
|
(if _saeulen
|
|
(progn
|
|
(tu-eq "geruest/saeulen-varianten" 6
|
|
(length (ssg-json-get _saeulen "geometrie_varianten")))
|
|
(tu-eq "geruest/saeulen-anbauteile" 7
|
|
(length (ssg-json-get _saeulen "anbaugruppen")))
|
|
(tu-eq "geruest/saeulen-titel" "Saeulen" (geruest-titel _saeulen))
|
|
;; R 1" ist die erste Variante und traegt die eigene TEILEART
|
|
(tu-eq "geruest/saeulen-1zoll-teileart" "Geruest Saeule 1 Zoll"
|
|
(geruest-variante-wert
|
|
(car (ssg-json-get _saeulen "geometrie_varianten"))
|
|
_saeulen "teileart"))
|
|
)
|
|
)
|
|
|
|
;; --- Rundlauf Schreiber -> Parser ---
|
|
;; Prueft den Konfigurations-Schreiber ohne BricsCAD-Dialog. Bewusst in
|
|
;; eine temporaere Datei: ein Test darf cfg/geruest_user.json nicht
|
|
;; ueberschreiben. Die Testdaten enthalten absichtlich Anfuehrungs-
|
|
;; zeichen - genau daran wuerde eine fehlende Maskierung scheitern.
|
|
(setq _rec
|
|
(list (cons "name" "Mein \"Satz\"")
|
|
(cons "variante" "ROHR R 1\" 33,7 x 2,6")
|
|
(cons "laenge" "2000")
|
|
(cons "teilefarbe" "RAL 7035 Lichtgrau")
|
|
(cons "oben" (list (list (cons "artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL")
|
|
(cons "menge" 2))))
|
|
(cons "unten" nil)))
|
|
(setq _pfad (vl-filename-mktemp "grtest" nil ".json"))
|
|
(setq _f (open _pfad "w"))
|
|
(write-line "{ \"Test\": [" _f)
|
|
(geruest-konfig-liste-schreiben _f (list _rec))
|
|
(write-line "] }" _f)
|
|
(close _f)
|
|
(setq _zurueck (car (ssg-json-get (ssg-json-laden _pfad) "Test")))
|
|
(vl-file-delete _pfad)
|
|
(tu-eq "geruest-schreiber/name" "Mein \"Satz\""
|
|
(ssg-json-get _zurueck "name"))
|
|
(tu-eq "geruest-schreiber/variante" "ROHR R 1\" 33,7 x 2,6"
|
|
(ssg-json-get _zurueck "variante"))
|
|
(tu-eq "geruest-schreiber/laenge" "2000"
|
|
(ssg-json-get _zurueck "laenge"))
|
|
(tu-eq "geruest-schreiber/farbe" "RAL 7035 Lichtgrau"
|
|
(ssg-json-get _zurueck "teilefarbe"))
|
|
(tu-eq "geruest-schreiber/oben-artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL"
|
|
(ssg-json-get (car (ssg-json-get _zurueck "oben")) "artikel"))
|
|
(tu-eq "geruest-schreiber/oben-menge" 2
|
|
(ssg-json-get (car (ssg-json-get _zurueck "oben")) "menge"))
|
|
(tu-eq "geruest-schreiber/unten-leer" nil
|
|
(ssg-json-get _zurueck "unten"))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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)
|
|
(tu-tests-sepliste)
|
|
(tu-tests-json)
|
|
(tu-tests-geruest)
|
|
|
|
(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)
|