;; ============================================================ ;; 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)) ) ;; ------------------------------------------------------------ ;; 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")) ) ;; ------------------------------------------------------------ ;; 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)