;; ============================================================ ;; 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) ;; ;; Ladearchitektur (EINHEITLICH): ;; Das Laden der zu testenden Module passiert AUSSCHLIESSLICH auf .scr- ;; Top-Level in tests/test_unit.scr - die Core-Module ueber ssg_load.lsp, ;; die lazy Feature-Module (GeruestInsert, count_sep_scan) per explizitem ;; load. Die Testbloecke hier laden NICHTS nach; sie pruefen nur per ;; atoms-family, ob ihr Modul vorhanden ist, und ueberspringen sich sonst ;; mit einer FAIL-Meldung. ;; Grund: In BricsCAD werden per load definierte Funktionen erst nach ;; Rueckkehr zum Top-Level sichtbar. Ein load INNERHALB von c:TEST_UNIT ;; oder eines per vl-catch-all-apply gecatchten Testblocks bindet die ;; frisch definierten Funktionen im laufenden Durchlauf NICHT (beobachtet: ;; geruest-id-string/cs-in-box blieben ungebunden). Darum gehoert alles ;; Laden vor den (c:TEST_UNIT)-Aufruf ins .scr. ;; ============================================================ ;; ------------------------------------------------------------ ;; 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_] -> [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)) ;; Reservierte IDs (XDATA SSG_ID_RES): Serialisierung + Maximum. (setq _rp '(("AS|1" . "0032") ("ES|4" . "0107"))) (tu-eq "ssg-id-res->strings" '("AS|1=0032" "ES|4=0107") (ssg-id-res->strings _rp)) (tu-eq "ssg-id-res-parse/rundlauf" _rp (ssg-id-res-parse (ssg-id-res->strings _rp))) (tu-eq "ssg-id-res-parse/ohne-gleich-ignoriert" '(("AS|1" . "0032")) (ssg-id-res-parse '("kaputt" "AS|1=0032"))) (tu-eq "ssg-id-res-parse/leerer-wert" '(("AS|1" . "")) (ssg-id-res-parse '("AS|1="))) (tu-eq "ssg-id-res-max" 107 (ssg-id-res-max _rp)) (tu-eq "ssg-id-res-max/leer" 0 (ssg-id-res-max nil)) ) ;; ------------------------------------------------------------ ;; 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: Eltern-Orientierung als 3x3-Rotationsmatrix (mat3-rz ;; liefert die Z-Drehmatrix aus dem Winkel - Signatur seit dem ;; Extrusions-Fix in export.lsp: parent-R statt parent-rot-rad). (tu-eqf "csv:local-to-world/keine-drehung" '(1.0 0.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (mat3-rz 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) (mat3-rz (/ 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")) ;; --- csv:sepliste-kette-paare: sepliste-Eintrag <-> Kettenbaustein ------- ;; Zuordnung ueber die Reihenfolge je Typ (k-tes AS/SEP/ES der sepliste = ;; k-tes der geordneten Kette), Rueckgabe ((lfdnr . index) ...). (tu-nil "csv:sepliste-kette-paare/leer" (csv:sepliste-kette-paare nil nil)) ;; HundM05-artige Kette: Koordinaten spielen keine Rolle (auch gespiegelte ;; x-Werte aendern nichts), Bausteine ohne sepliste-Typ werden uebersprungen. (setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 -9999.0 0.0) ("SEP" 3 2000.0 0.0) ("ES" 4 3000.0 0.0))) (tu-eq "csv:sepliste-kette-paare/kette" '((1 . 0) (2 . 2) (3 . 5) (4 . 7)) (csv:sepliste-kette-paare _e '("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "MOTORSTATION" "SEP" "BOGEN" "ES"))) ;; lfdnr-Reihenfolge zaehlt, nicht die Reihenfolge der Eintraege in der Liste. (setq _e '(("SEP" 3 0.0 0.0) ("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0))) (tu-eq "csv:sepliste-kette-paare/unsortiert" '((1 . 0) (2 . 1) (3 . 2)) (csv:sepliste-kette-paare _e '("AS" "SEP" "SEP"))) ;; Mehr Eintraege als Bausteine: die ueberzaehligen bleiben ohne Partner. (setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0) ("SEP" 3 0.0 0.0))) (tu-eq "csv:sepliste-kette-paare/fehlender-baustein" '((1 . 0) (2 . 2)) (csv:sepliste-kette-paare _e '("AS" "BOGEN" "SEP" "ES"))) ;; --- csv:asmark-finden: bisherigen AS/ES-Marker im Bestand wiederfinden --- ;; Schluessel ist (Wrapper-ID, Typ, lfdnr) - alle drei muessen passen, sonst ;; bekaeme ein Kettenende die ID eines fremden Markers. Bestandsformat: ;; (ename zuordnung typ lfdnr id), siehe csv:asmark-sammeln. (setq _mk '((ME1 "0021" "AS" "1" "0031") (ME2 "0021" "ES" "4" "0032") (ME3 "0022" "AS" "1" "0033"))) (tu-eq "csv:asmark-finden/treffer" '(ME2 "0021" "ES" "4" "0032") (csv:asmark-finden _mk "0021" "ES" "4")) (tu-eq "csv:asmark-finden/anderer-wrapper" '(ME3 "0022" "AS" "1" "0033") (csv:asmark-finden _mk "0022" "AS" "1")) (tu-nil "csv:asmark-finden/falsche-lfdnr" (csv:asmark-finden _mk "0021" "AS" "2")) (tu-nil "csv:asmark-finden/falscher-typ" (csv:asmark-finden _mk "0021" "SEP" "1")) (tu-nil "csv:asmark-finden/ohne-wrapper-id" (csv:asmark-finden _mk "" "AS" "1")) (tu-nil "csv:asmark-finden/leerer-bestand" (csv:asmark-finden nil "0021" "AS" "1")) ;; csv:asmark-res-key: Schluessel der reservierten ID am Wrapper - lfdnr als ;; Integer (csv:asmark-aktualisieren) und String muss denselben liefern. (tu-eq "csv:asmark-res-key/int" "AS|1" (csv:asmark-res-key "AS" 1)) (tu-eq "csv:asmark-res-key/str" "ES|4" (csv:asmark-res-key "ES" "4")) (tu-eq "csv:res-key-kette" "K|7" (csv:res-key-kette 7)) (tu-eq "csv:res-key-einheit" "U|2" (csv:res-key-einheit 2)) ;; csv:res-merken: Anmeldungen je Wrapper zusammenfuehren (ein Eintrag je ;; Wrapper, Reihenfolge der Anmeldung). Symbole statt enames - rein ;; listenbasiert. Globale Sammlung sichern und wiederherstellen. (setq _rs *csv-res-sammlung* *csv-res-sammlung* nil) (csv:res-merken 'W1 "AS|1" 'M1) (csv:res-merken 'W2 "K|0" 'M2) (csv:res-merken 'W1 "K|3" 'M3) (tu-eq "csv:res-merken/je-wrapper" '((W1 ("AS|1" . M1) ("K|3" . M3)) (W2 ("K|0" . M2))) (vl-sort *csv-res-sammlung* (function (lambda (a b) (< (vl-symbol-name (car a)) (vl-symbol-name (car b))))))) (setq *csv-res-sammlung* _rs) ;; csv:pattern-nested-element: Suchmuster = alle Familienmuster aus ;; csv:element-familien - jede Familie ist also auch klassifizierbar. (tu-eq "csv:pattern-nested-element/aus-familien" (ssg-join (mapcar 'cdr (csv:element-familien)) ",") (csv:pattern-nested-element)) (tu-true "csv:element-familien/jedes-muster-klassifiziert" (not (vl-some (function (lambda (f) (not (equal (car f) (csv:element-teileart (vl-string-subst "X" "*" (substr (cdr f) 1 (cond ((vl-string-search "," (cdr f))) ((strlen (cdr f))))))))))) (csv:element-familien)))) ;; csv:element-teileart: TeileArt-Familie eines ausgepackten VF_n/GF_n- ;; Bausteins aus dem Blocknamen (Boegen/Streckenelement/Umlenk-/Motor- ;; station). Vario_Bogen_* deckt sowohl die _TEF_- als auch die reine ;; GF-Variante ab, beide auf denselben Bucket "BOGEN". (tu-eq "csv:element-teileart/gefaellebogen" "BOGEN" (csv:element-teileart "Gefaellebogen_links_90_R500")) (tu-eq "csv:element-teileart/vario-bogen-tef" "BOGEN" (csv:element-teileart "Vario_Bogen_auf_3_TEF_rechts")) (tu-eq "csv:element-teileart/vario-bogen-gf" "BOGEN" (csv:element-teileart "Vario_Bogen_ab_6_rechts")) (tu-eq "csv:element-teileart/vario-kurve" "BOGEN" (csv:element-teileart "Vario_Kurve_links_30_TEF_innen")) (tu-eq "csv:element-teileart/streckenelement" "STRECKENELEMENT" (csv:element-teileart "Staustrecke_SP_1000_mm")) (tu-eq "csv:element-teileart/umlenkstation" "UMLENKSTATION" (csv:element-teileart "Vario_Umlenkstation_500mm_links")) (tu-eq "csv:element-teileart/motorstation" "MOTORSTATION" (csv:element-teileart "Vario_Motorstation_500mm_rechts")) (tu-eq "csv:element-teileart/unbekannt" nil (csv:element-teileart "AS_Element_90_links")) ;; --- csv:kette-typ: Bausteintyp einer VF_n/GF_n-Kette aus dem Blocknamen -- (tu-eq "csv:kette-typ/as" "AS" (csv:kette-typ "AS_Element_90_links_3D")) (tu-eq "csv:kette-typ/es" "ES" (csv:kette-typ "ES_Element_30_rechts_2D")) (tu-eq "csv:kette-typ/sep" "SEP" (csv:kette-typ "Staustrecke_Separator_SP_300_mm_3D")) (tu-eq "csv:kette-typ/streckenelement" "STRECKENELEMENT" (csv:kette-typ "Staustrecke_SP_1000_mm_3D")) (tu-eq "csv:kette-typ/umlenk" "UMLENKSTATION" (csv:kette-typ "Vario_Umlenkstation_500mm_rechts_3D")) (tu-nil "csv:kette-typ/symbol-ist-kein-baustein" (csv:kette-typ "Separator_SP_3D")) ;; --- csv:kette-einheiten: geordnete Typfolge in VF-/GF-Einheiten schneiden ;; VF = Separator vor der Umlenkstation ... Motorstation; alles dazwischen ;; GF; AS/ES gehoeren zu keiner Einheit. Reine Rechenfunktion. ;; HundM05 VF_5 (Bausteinfolge aus der Testzeichnung, per KS-Kette geordnet): ;; GF(1) VF(2..10) GF(11 12) VF(13..25) GF(26 27) - passt zu L_GF_m ;; "0.727,0.201,0.318" des Wrappers (drei Gefaelleabschnitte). (setq _kette-hundm05 '("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT" "BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "MOTORSTATION" "SEP" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN" "MOTORSTATION" "STRECKENELEMENT" "SEP" "ES")) (tu-eq "csv:kette-einheiten/hundm05" '(("GF" (1)) ("VF" (2 3 4 5 6 7 8 9 10)) ("GF" (11 12)) ("VF" (13 14 15 16 17 18 19 20 21 22 23 24 25)) ("GF" (26 27))) (csv:kette-einheiten _kette-hundm05)) ;; Reine Gefaellestrecke ohne Stationen -> eine einzige GF. (tu-eq "csv:kette-einheiten/nur-gf" '(("GF" (1 2 3))) (csv:kette-einheiten '("AS" "STRECKENELEMENT" "BOGEN" "SEP" "ES"))) ;; Kette beginnt direkt mit dem Foerderer (Separator gleich hinter dem AS), ;; endet mit der Motorstation vor dem ES -> nur eine VF, keine leeren GF. (tu-eq "csv:kette-einheiten/nur-vf" '(("VF" (1 2 3 4))) (csv:kette-einheiten '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES"))) ;; Umlenkstation ohne Separator davor beginnt die VF selbst; der Separator, ;; der NICHT vor einer Umlenkstation steht, bleibt im Gefaelle. (tu-eq "csv:kette-einheiten/umlenk-ohne-sep" '(("GF" (1 2)) ("VF" (3 4 5))) (csv:kette-einheiten '("AS" "SEP" "BOGEN" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES"))) ;; --- csv:kette-sep-typen: Separator erbt den Typ seiner Einheit --- ;; HundM05 VF_5: Einlauf-Separator vor der Umlenkstation (2) -> VF; der ;; Separator hinter der Motorstation (11) -> GF; der Separator hinter dem ;; Gefaellestueck, der zugleich Einlauf der zweiten VF ist (13) -> VF; der ;; Separator vor dem ES (27) -> GF. (tu-eq "csv:kette-sep-typen/hundm05" '((2 . "VF") (11 . "GF") (13 . "VF") (27 . "GF")) (csv:kette-sep-typen _kette-hundm05)) ;; Separator INNERHALB der VF (vor der Motorstation) -> VF. (tu-eq "csv:kette-sep-typen/sep-im-koerper" '((1 . "VF") (4 . "VF") (7 . "GF")) (csv:kette-sep-typen '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "SEP" "STRECKENELEMENT" "MOTORSTATION" "SEP" "ES"))) ;; Reine Gefaellestrecke -> alle GF; Kette ohne Separator -> nil. (tu-eq "csv:kette-sep-typen/nur-gf" '((1 . "GF") (3 . "GF")) (csv:kette-sep-typen '("AS" "SEP" "STRECKENELEMENT" "SEP" "ES"))) (tu-nil "csv:kette-sep-typen/ohne-sep" (csv:kette-sep-typen '("AS" "STRECKENELEMENT" "ES"))) ;; --- csv:kette-ordnen: Vektorkette K2 -> K1, unabhaengig von der ;; Eingangsreihenfolge; Start am AS. rec wird dafuer nicht gebraucht (nil). (setq _t-as (list "AS" nil '(0.0 0.0 0.0) '(10.0 0.0 0.0))) (setq _t-s1 (list "STRECKENELEMENT" nil '(10.0 0.0 0.0) '(20.0 0.0 0.0))) (setq _t-b (list "BOGEN" nil '(20.0 0.0 0.0) '(20.0 10.0 0.0))) (setq _t-es (list "ES" nil '(20.0 10.0 0.0) '(30.0 10.0 0.0))) (tu-eq "csv:kette-ordnen/verwuerfelt" (list _t-as _t-s1 _t-b _t-es) (csv:kette-ordnen (list _t-b _t-es _t-as _t-s1) "TEST")) ;; Innerhalb der Toleranz (2 mm) gilt ein Anschluss noch als geschlossen. (setq _t-s1b (list "STRECKENELEMENT" nil '(11.5 0.0 0.0) '(20.0 0.0 0.0))) (tu-eq "csv:kette-ordnen/toleranz" (list _t-as _t-s1b) (csv:kette-ordnen (list _t-s1b _t-as) "TEST")) ;; --- csv:export-modus-setzen / -p-Praedikate: 3 Modi + Ungueltig-Schutz -- ;; Bestehenden Modus sichern/wiederherstellen, damit dieser Testblock keine ;; Seiteneffekte auf nachfolgende Tests oder eine laufende Sitzung hat. ;; --- Hilfskopien behalten: EIN Schalter (csv_leave_proxies), der Dialog ;; schaltet denselben Zustand. Alten Wert sichern/wiederherstellen. (setq _hk-alt (csv:hilfskopien-behalten-p)) (csv:hilfskopien-behalten-setzen T) (tu-true "csv:hilfskopien-behalten/an" (csv:hilfskopien-behalten-p)) (tu-true "csv:hilfskopien-behalten/an-ist-dbg-schalter" (dbg-schalter-p "csv_leave_proxies")) (csv:hilfskopien-behalten-setzen nil) (tu-nil "csv:hilfskopien-behalten/aus" (csv:hilfskopien-behalten-p)) (csv:hilfskopien-behalten-setzen _hk-alt) (setq _modus-alt *csv-export-modus*) (csv:export-modus-setzen "all_elements") (tu-eq "csv:export-modus-setzen/all_elements" "all_elements" *csv-export-modus*) (tu-true "csv:export-alle-elemente-p/all_elements" (csv:export-alle-elemente-p)) (tu-nil "csv:export-separator-track-p/all_elements" (csv:export-separator-track-p)) (csv:export-modus-setzen "group_vf_gf") (tu-eq "csv:export-modus-setzen/group_vf_gf" "group_vf_gf" *csv-export-modus*) (tu-nil "csv:export-alle-elemente-p/group_vf_gf" (csv:export-alle-elemente-p)) (tu-nil "csv:export-separator-track-p/group_vf_gf" (csv:export-separator-track-p)) (csv:export-modus-setzen "separator_track") (tu-eq "csv:export-modus-setzen/separator_track" "separator_track" *csv-export-modus*) (tu-nil "csv:export-alle-elemente-p/separator_track" (csv:export-alle-elemente-p)) (tu-true "csv:export-separator-track-p/separator_track" (csv:export-separator-track-p)) ;; Ungueltiger Wert wird ignoriert - Modus bleibt auf dem zuletzt gueltig ;; gesetzten Stand (hier "separator_track"). (csv:export-modus-setzen "unbekannt") (tu-eq "csv:export-modus-setzen/ungueltig-ignoriert" "separator_track" *csv-export-modus*) (csv:export-modus-setzen _modus-alt) ) ;; ------------------------------------------------------------ ;; 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-fmt-koord: GENAU 2 Nachkommastellen, DIMZIN-unabhaengig. ;; Ersetzt rtos (das bei DIMZIN=8 abschliessende Nullen verschluckt und die ;; XDATA-Serialisierung zeichnungsprofilabhaengig gemacht hat). (tu-eq "sepliste-fmt/ganz" "10.00" (ssg-sepliste-fmt-koord 10.0)) (tu-eq "sepliste-fmt/eine-stelle" "30.50" (ssg-sepliste-fmt-koord 30.5)) (tu-eq "sepliste-fmt/rundung-ab" "5.01" (ssg-sepliste-fmt-koord 5.007)) (tu-eq "sepliste-fmt/uebertrag" "10.00" (ssg-sepliste-fmt-koord 9.999)) (tu-eq "sepliste-fmt/negativ" "-5.00" (ssg-sepliste-fmt-koord -5.0)) (tu-eq "sepliste-fmt/negativ-rund" "-5.01" (ssg-sepliste-fmt-koord -5.007)) (tu-eq "sepliste-fmt/null" "0.00" (ssg-sepliste-fmt-koord 0.0)) ;; 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]") ;; GeruestInsert ist ein lazy Feature-Modul (nicht in der Core-Ladeliste). ;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur ;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur). (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")) ) ) ) ;; ------------------------------------------------------------ ;; TESTS: count_sep_scan.lsp - geometrische Sensor-Zuordnung ;; ;; Testet die durch die Zerlegung von cs-zuordnung-lauf isolierte, ;; rein funktionale Kernlogik: Carrier-Records sind plain Listen ;; (ename tagS tagP minx miny maxx maxy cx cy id label), Sensoren ;; sind Punkte (x y). Kein ssget/entget/entmod - der ename an ;; Position 0 wird von den Geometrie-Routinen nie dereferenziert, ;; darum genuegt ein Symbol-Platzhalter. *senstol* wird fuer ;; deterministische Ergebnisse explizit gesetzt (sonst cfg-abhaengig). ;; ------------------------------------------------------------ ;; Record-Konstruktor fuers Testen: baut einen Carrier-Record so, wie ;; ihn cs-sammle-bloecke liefert - nur die Box-/Zentrum-/ID-Felder ;; (Index 3-9), die die Geometrie-Routinen lesen, sind relevant; ename ;; und label sind reine Platzhalter. ;; (name minx miny maxx maxy id) -> voller Carrier-Record (defun tu-mk-carr (name minx miny maxx maxy id) (list name "ANZAHL_SCANNER" "ANZAHL_SEPARATOR" minx miny maxx maxy (/ (+ minx maxx) 2.0) (/ (+ miny maxy) 2.0) id (strcat "L-" name))) (defun tu-tests-sepscan ( / _senstol-alt _a _b _c _carr _grid _res) (princ "\n[count_sep_scan]") ;; count_sep_scan ist ein lazy Feature-Modul (nicht in der Core-Ladeliste). ;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur ;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur). (if (null (atoms-family 1 '("CS-RESOLVE-SENSOR"))) (tu-record nil "sepscan/modul" "count_sep_scan.lsp nicht geladen") (progn (setq _senstol-alt (if (boundp '*senstol*) *senstol*)) (setq *senstol* 0.0) ;; --- cs-in-box: Punkt in Carrier-Box (X/Y, Z ignoriert) --- (setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001")) (tu-true "cs-in-box/mitte" (cs-in-box '(50.0 50.0) _a)) (tu-true "cs-in-box/rand" (cs-in-box '(0.0 0.0) _a)) (tu-nil "cs-in-box/ausserhalb-x" (cs-in-box '(150.0 50.0) _a)) (tu-nil "cs-in-box/ausserhalb-y" (cs-in-box '(50.0 -1.0) _a)) ;; --- *senstol* vergroessert die Box --- (setq *senstol* 10.0) (tu-true "cs-in-box/toleranz-innen" (cs-in-box '(105.0 50.0) _a)) (tu-nil "cs-in-box/toleranz-aussen" (cs-in-box '(111.0 50.0) _a)) (setq *senstol* 0.0) ;; --- cs-bump: Zaehler je ename hochzaehlen --- (tu-eq "cs-bump/neu" '(("k" . 1)) (cs-bump nil "k")) (tu-eq "cs-bump/erhoeht" '(("k" . 2)) (cs-bump '(("k" . 1)) "k")) (tu-eq "cs-bump/zweiter-key" '(("m" . 1) ("k" . 1)) (cs-bump '(("k" . 1)) "m")) ;; --- cs-carrier-by-id: Record ueber ID (Feld 9) finden --- (setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002")) (setq _carr (list _a _b)) (tu-eq "cs-carrier-by-id/treffer" _b (cs-carrier-by-id "0002" _carr)) (tu-nil "cs-carrier-by-id/fehlt" (cs-carrier-by-id "9999" _carr)) (tu-nil "cs-carrier-by-id/leer" (cs-carrier-by-id "" _carr)) (tu-nil "cs-carrier-by-id/nil" (cs-carrier-by-id nil _carr)) ;; --- cs-assign: BBox-Zuordnung ueber das Grid --- ;; Zwei getrennte Boxen: Punkt in genau einer -> diese. (setq _grid (cs-grid-build _carr)) (tu-eq "cs-assign/box-a" _a (cs-assign '(50.0 50.0) _grid)) (tu-eq "cs-assign/box-b" _b (cs-assign '(250.0 50.0) _grid)) (tu-nil "cs-assign/keine-box" (cs-assign '(1000.0 1000.0) _grid)) ;; Ueberlappende Boxen -> naechstes Box-Zentrum gewinnt (Tiebreak). ;; C: 0..100, D: 40..200; Punkt (45,50) liegt in beiden, ;; C-Zentrum (50,50) ist naeher als D-Zentrum (120,50). (setq _a (tu-mk-carr "C" 0.0 0.0 100.0 100.0 "0003")) (setq _b (tu-mk-carr "D" 40.0 0.0 200.0 100.0 "0004")) (setq _grid (cs-grid-build (list _a _b))) (tu-eq "cs-assign/overlap-naechstes-zentrum" _a (cs-assign '(45.0 50.0) _grid)) ;; --- cs-nearest-two: die zwei naechsten Carrier nach Zentrum --- ;; Zentren: A(50,50) B(250,50) C(50,250). Punkt (60,60): ;; naechster A, zweiter B (dx 190 < dy 190? -> Abstand B=~194, C=~190). (setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001")) (setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002")) (setq _c (tu-mk-carr "C" 0.0 200.0 100.0 300.0 "0003")) (setq _res (cs-nearest-two '(60.0 60.0) (list _a _b _c))) (tu-eq "cs-nearest-two/naechster" _a (nth 0 _res)) (tu-true "cs-nearest-two/zweiter-vorhanden" (nth 2 _res)) ;; Abstand zum naechsten (A-Zentrum 50,50) = sqrt(10^2+10^2) ~ 14.14 (tu-eqf "cs-nearest-two/best-dist" (distance '(60.0 60.0) '(50.0 50.0)) (nth 1 _res)) ;; Nur ein Carrier -> zweiter ist nil. (setq _res (cs-nearest-two '(60.0 60.0) (list _a))) (tu-eq "cs-nearest-two/einzeln-best" _a (nth 0 _res)) (tu-nil "cs-nearest-two/einzeln-kein-zweiter" (nth 2 _res)) ;; --- cs-resolve-sensor: der Entscheider bbox/distance/none --- ;; Punkt in einer Box -> modus 'bbox, kein Distanzfeld. (setq _grid (cs-grid-build (list _a _b _c))) (setq _res (cs-resolve-sensor '(50.0 50.0) (list _a _b _c) _grid)) (tu-eq "cs-resolve/bbox-modus" 'bbox (nth 0 _res)) (tu-eq "cs-resolve/bbox-rec" _a (nth 1 _res)) (tu-nil "cs-resolve/bbox-kein-dist" (nth 2 _res)) ;; Punkt ausserhalb aller Boxen, aber Carrier vorhanden -> 'distance. (setq _res (cs-resolve-sensor '(1000.0 1000.0) (list _a _b _c) _grid)) (tu-eq "cs-resolve/distance-modus" 'distance (nth 0 _res)) (tu-true "cs-resolve/distance-rec" (nth 1 _res)) (tu-true "cs-resolve/distance-dist" (nth 2 _res)) ;; Gar keine Carrier -> 'none. (setq _grid (cs-grid-build nil)) (setq _res (cs-resolve-sensor '(50.0 50.0) nil _grid)) (tu-eq "cs-resolve/none-modus" 'none (nth 0 _res)) (tu-nil "cs-resolve/none-rec" (nth 1 _res)) ;; *senstol* wieder herstellen (setq *senstol* _senstol-alt) ) ) ) ;; ------------------------------------------------------------ ;; 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 ) ) ;; ------------------------------------------------------------ ;; TESTS: vf_linienzug.lsp - SEGS-Journal-Serialisierung (Modus 3) ;; ------------------------------------------------------------ ;; Roundtrip der Segment-Essenz: die Zahlenliste, die Modus 3 aus den Pfad- ;; Objekten ableitet, muss verlustfrei durch String<->Liste und durch die ;; Journal-Eintrags-Serialisierung laufen - das ist die Grundlage dafuer, dass ;; ein Modus-3-Block per Doppelklick 1:1 aus dem XDATA-Journal nachgebaut wird. (defun tu-tests-vfl-segs ( / _seg _segs _s _e) (princ "\n[vf_linienzug/SEGS]") (if (null (atoms-family 1 '("VFL-SEGS->STRING"))) (tu-record nil "vfl-segs/modul" "vf_linienzug.lsp nicht geladen (VFL-SEGS->STRING fehlt)") (progn ;; Einzelsegment (Bogen, alle Felder gesetzt) Roundtrip (setq _seg '("Bogen" 102.5 707.106781 90 "rechts" 1000.0 2000.0 1500.5 2500.25)) (tu-eqf "vfl-seg/roundtrip-bogen" _seg (vfl-string->seg (vfl-seg->string _seg))) ;; Linie (bwinkel 0, bseite default) Roundtrip (setq _seg '("Linie" 30.0 4200.0 0 "links" 0.0 0.0 3637.31 2100.0)) (tu-eqf "vfl-seg/roundtrip-linie" _seg (vfl-string->seg (vfl-seg->string _seg))) ;; Ganze Segmentliste (Linie + Bogen + Linie) Roundtrip (setq _segs (list '("Linie" 0.0 3000.0 0 "links" 0.0 0.0 3000.0 0.0) '("Bogen" 0.0 707.106781 90 "rechts" 3000.0 0.0 3500.0 -500.0) '("Linie" 270.0 2500.0 0 "links" 3500.0 -500.0 3500.0 -3000.0))) (tu-eqf "vfl-segs/roundtrip-liste" _segs (vfl-string->segs (vfl-segs->string _segs))) ;; Leere Liste -> "" -> leere Liste (tu-eq "vfl-segs/leer-string" "" (vfl-segs->string '())) (tu-nil "vfl-segs/leer-parse" (vfl-string->segs "")) ;; Einbettung als Journal-Eintrag: (SEGS . liste) durch ;; vfl-entry->string / vfl-string->entry (setq _e (cons "SEGS" _segs)) (setq _s (vfl-entry->string _e)) (tu-true "vfl-segs/entry-praefix" (= "SEGS:" (substr _s 1 5))) (tu-eqf "vfl-segs/entry-roundtrip" _e (vfl-string->entry _s)) ;; Delimiter-Sicherheit: die serialisierte Form enthaelt genau die ;; erwarteten Trenner und KEIN Newline (sonst zerrisse der Record-Trenner) (tu-nil "vfl-segs/kein-newline" (vl-string-search "\n" (vfl-segs->string _segs))) ;; vfl-journal-hat-segs-p: unterscheidet neue SEGS-Ketten von alten ;; OBJS-"linienzug2"-Bloecken (harter Schnitt beim Doppelklick). (if (atoms-family 1 '("VFL-JOURNAL-HAT-SEGS-P")) (progn ;; SEGS-Journal (Modus 2 neu / Modus 3): erkannt (tu-true "vfl-hat-segs/mit-segs" (vfl-journal-hat-segs-p (list (cons "PT" '(0.0 0.0 0.0)) (cons "SEGS" _segs)))) ;; Altes OBJS-Journal (Objekt-Handles): NICHT als SEGS erkannt (tu-nil "vfl-hat-segs/nur-objs" (vfl-journal-hat-segs-p (list (cons "PT" '(0.0 0.0 0.0)) (cons "OBJS" '("A1" "A2"))))) ;; Leeres Journal: nil (tu-nil "vfl-hat-segs/leer" (vfl-journal-hat-segs-p '()))) (tu-record nil "vfl-hat-segs/modul" "VFL-JOURNAL-HAT-SEGS-P fehlt")) ) ) ) ;; ------------------------------------------------------------ ;; TESTS: vf_linienzug.lsp - gemeinsamer Abbruch-Handler-Konstruktor ;; ------------------------------------------------------------ ;; vfl-abbruch-handler-installieren baut *error* als Lambda-Liste, in die der ;; Marker ("linienzug"/"linienzug2"/"linienzug3") als String-Literal eingebaut ;; ist. Der wortgleiche Wickel-Handler steht damit nur noch EINMAL statt 3x. ;; Getestet wird die KONSTRUKTION (Marker an der richtigen Stelle, Struktur ;; aufrufbar) - NICHT ein echter Abbruch (der braeuchte Zeichnung/Geometrie). ;; *error* wird gesichert und wiederhergestellt, damit der Testlauf unberuehrt ;; bleibt. (defun tu-tests-vfl-abbruch ( / _save _h _call) (princ "\n[vf_linienzug/Abbruch-Handler]") (if (null (atoms-family 1 '("VFL-ABBRUCH-HANDLER-INSTALLIEREN"))) (tu-record nil "vfl-abbruch/modul" "vf_linienzug.lsp nicht geladen (VFL-ABBRUCH-HANDLER-INSTALLIEREN fehlt)") (progn (setq _save *error*) (setq _h (vfl-abbruch-handler-installieren "linienzug2")) ;; Rueckgabe = das gesetzte *error* (identisch) (tu-true "vfl-abbruch/setzt-error" (equal _h *error*)) ;; Struktur: (lambda (msg) ...) - erstes Element lambda, zweites (msg) (tu-eq "vfl-abbruch/ist-lambda" 'lambda (car _h)) (tu-eq "vfl-abbruch/arg-msg" '(msg) (cadr _h)) ;; Der vfl-modus-abbruch-sichern-Aufruf im Rumpf traegt GENAU den ;; uebergebenen Marker als letztes Argument (nicht einen anderen Modus). (setq _call (car (vl-member-if (function (lambda (f) (and (listp f) (eq (car f) 'vfl-modus-abbruch-sichern)))) (cddr _h)))) (tu-true "vfl-abbruch/ruft-sichern" (not (null _call))) (tu-eq "vfl-abbruch/marker-linienzug2" "linienzug2" (last _call)) ;; Anderer Marker -> anderes Literal an derselben Position (vfl-abbruch-handler-installieren "linienzug3") (setq _call (car (vl-member-if (function (lambda (f) (and (listp f) (eq (car f) 'vfl-modus-abbruch-sichern)))) (cddr *error*)))) (tu-eq "vfl-abbruch/marker-linienzug3" "linienzug3" (last _call)) ;; *error* wiederherstellen - Testlauf darf nicht mit einem Wickel-Handler ;; ohne gebundene Modus-Locals zurueckbleiben. (setq *error* _save) ) ) ) ;; ------------------------------------------------------------ ;; BEFEHL: TEST_UNIT ;; ------------------------------------------------------------ ;; Testblock geschuetzt aufrufen: ein harter LISP-Fehler in einem Block ;; wird als FAIL erfasst, statt c:TEST_UNIT abzubrechen und damit den ;; Report zu verhindern. Der Blockname (String) wird per read zur Funktion. (defun tu-run-block (fn / res) (setq res (vl-catch-all-apply (read fn) nil)) (if (vl-catch-all-error-p res) (tu-record nil (strcat fn "/ausfuehrung") (strcat "harter Fehler: " (vl-catch-all-error-message res)))) ) (defun c:TEST_UNIT ( / out-dir report) (tu-reset) (princ "\n================================================================") (princ "\n TEST_UNIT - LISP-Standardfunktionen") (princ "\n================================================================") (foreach fn '("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" "tu-tests-sepscan" "tu-tests-vfl-segs" "tu-tests-vfl-abbruch") (tu-run-block fn)) (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)