Michael Stangl
69a192b83a
Neuer Menuepunkt Konfiguration > CSV-Export (CSV_EXPORT_KONFIG) mit DCL- Dialog: drei sich ausschliessende Export-Modi (group_vf_gf/all_elements/ separator_track, letzterer neu - nur AS/ES/Separator) ueber die zentrale Variable *csv-export-modus*, sowie zwei unabhaengige Haken fuer sichtbare Element-Proxy-Kopien (Zuordnung pruefen / Kopien behalten).
1209 lines
57 KiB
Common Lisp
1209 lines
57 KiB
Common Lisp
;; ============================================================
|
|
;; test_unit.lsp - Unit-Tests fuer einfache LISP-Standardfunktionen
|
|
;;
|
|
;; Testet reine Hilfsfunktionen (String, Zahl, Vektor, Liste,
|
|
;; Alist), die OHNE Zeichnungsdatenbank, Auswahlsaetze, Dialoge
|
|
;; oder Blockdateien auskommen - analog zu den Python-Unittests,
|
|
;; nur direkt in AutoLISP formuliert. Jeder Testfall vergleicht
|
|
;; einen Funktionsaufruf gegen ein erwartetes Ergebnis.
|
|
;;
|
|
;; Aufruf in BricsCAD (SSG_LIB muss geladen sein):
|
|
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
|
|
;; TEST_UNIT
|
|
;;
|
|
;; Ueber die Kommandozeile:
|
|
;; bin\run_tests.bat --lisp
|
|
;; (startet BricsCAD mit tests/output/_unit_run.scr, laedt SSG_LIB,
|
|
;; fuehrt TEST_UNIT aus und schreibt tests/output/unit_results.txt)
|
|
;;
|
|
;; Ergebnis:
|
|
;; Konsole: PASS/FAIL je Test + Zusammenfassung
|
|
;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen)
|
|
;;
|
|
;; 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_<dim>] -> [allgemein].
|
|
;; Dimension und cfg werden hier injiziert (kein Datei-IO); der gemerkte
|
|
;; Ladeversuch verhindert, dass ssg-layer-cfg-load die echte Datei liest.
|
|
(setq _lay-cfg-alt *ssg-layer-cfg*
|
|
_lay-vers-alt *ssg-layer-cfg-versucht*
|
|
_lay-dim-alt (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
|
|
(setq *ssg-layer-cfg* _lay *ssg-layer-cfg-versucht* T)
|
|
(setq *ssg-ils-dim* "2D")
|
|
(tu-eq "ssg-layer-eintrag/dim-2d"
|
|
'("ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
|
|
(tu-eq "ssg-layer-eintrag/fallback-allgemein"
|
|
'("VF_Beschriftung" . "7") (ssg-layer-eintrag "vf_beschriftung"))
|
|
(setq *ssg-ils-dim* "3D")
|
|
(tu-eq "ssg-layer-eintrag/dim-3d"
|
|
'("_3D_ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
|
|
(tu-nil "ssg-layer-eintrag/unbekannte-baugruppe"
|
|
(ssg-layer-eintrag "gibtsnicht"))
|
|
|
|
;; ssg-layer-farbe-fuer-name: Farbe zu einem LAYERNAMEN (nicht Baugruppe).
|
|
;; Wird gebraucht, weil Layer aus dem LAYER-Attribut oft VOR dem Wrapper
|
|
;; angelegt werden und ssg-make-layer die Farbe nur bei Neuanlage setzt.
|
|
(setq *ssg-layer-cfg* (ssg-ini-parse-lines
|
|
'("[ils_3d]"
|
|
"gefaellestrecke = _3D_ILS_SP, 3"
|
|
"[allgemein]"
|
|
"vf_beschriftung = VF_Beschriftung, 7"
|
|
"[farben]"
|
|
"ILS_SEP-SP = 82")))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/abschnitt-farben"
|
|
"82" (ssg-layer-farbe-fuer-name "ILS_SEP-SP"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/aus-baugruppen-wert"
|
|
"3" (ssg-layer-farbe-fuer-name "_3D_ILS_SP"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/case-insensitiv"
|
|
"3" (ssg-layer-farbe-fuer-name "_3d_ils_sp"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/unbekannt-default-7"
|
|
"7" (ssg-layer-farbe-fuer-name "GibtsNicht"))
|
|
(tu-eq "ssg-layer-farbe-fuer-name/leerer-name"
|
|
"7" (ssg-layer-farbe-fuer-name ""))
|
|
;; Globale Zustaende wieder herstellen
|
|
(setq *ssg-ils-dim* _lay-dim-alt
|
|
*ssg-layer-cfg* _lay-cfg-alt
|
|
*ssg-layer-cfg-versucht* _lay-vers-alt)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: ssg_lang.lsp - Textersetzung
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-lang ()
|
|
(princ "\n[ssg_lang]")
|
|
|
|
;; ssg-str-replace-all: (neu alt str)
|
|
(tu-eq "ssg-str-replace-all/alle" "fXX" (ssg-str-replace-all "X" "o" "foo"))
|
|
(tu-eq "ssg-str-replace-all/mehrfach" "a-b-c" (ssg-str-replace-all "-" "." "a.b.c"))
|
|
(tu-eq "ssg-str-replace-all/keins" "abc" (ssg-str-replace-all "X" "z" "abc"))
|
|
|
|
;; ssg-lang-unescape: literales \n (Backslash+n) -> echter Zeilenumbruch
|
|
(setq _u (ssg-lang-unescape (strcat "a" "\\n" "b")))
|
|
(tu-eq "ssg-lang-unescape/laenge" 3 (strlen _u))
|
|
(tu-eq "ssg-lang-unescape/newline" (chr 10) (substr _u 2 1))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: ssg_id.lsp - ID-Formatierung
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-id ()
|
|
(princ "\n[ssg_id]")
|
|
(tu-eq "ssg-id-format/1" "0001" (ssg-id-format 1))
|
|
(tu-eq "ssg-id-format/42" "0042" (ssg-id-format 42))
|
|
(tu-eq "ssg-id-format/1000" "1000" (ssg-id-format 1000))
|
|
(tu-eq "ssg-id-format/12345" "12345" (ssg-id-format 12345))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: vf_core.lsp - Vektor-/Frame-Mathematik
|
|
;; ------------------------------------------------------------
|
|
(defun tu-tests-vfcore ()
|
|
(princ "\n[vf_core]")
|
|
|
|
(tu-eqf "vec-length/3-4-0" 5.0 (vec-length '(3.0 4.0 0.0)))
|
|
|
|
(tu-eqf "vec3-cross/x-cross-y" '(0.0 0.0 1.0) (vec3-cross '(1.0 0.0 0.0) '(0.0 1.0 0.0)))
|
|
(tu-eqf "vec3-cross/z-cross-x" '(0.0 1.0 0.0) (vec3-cross '(0.0 0.0 1.0) '(1.0 0.0 0.0)))
|
|
|
|
(tu-eqf "vec3-normalize/z5" '(0.0 0.0 1.0) (vec3-normalize '(0.0 0.0 5.0)))
|
|
|
|
(tu-eqf "mat3-mul-vec3/identitaet"
|
|
'(2.0 3.0 4.0)
|
|
(mat3-mul-vec3 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) '(2.0 3.0 4.0)))
|
|
|
|
(tu-eqf "punkt-differenz" '(3.0 4.0 5.0) (punkt-differenz '(1.0 1.0 1.0) '(4.0 5.0 6.0)))
|
|
|
|
(tu-eq "ks-normalize-name/ksys-ein" "KS_EIN" (ks-normalize-name "KSYS_EIN"))
|
|
(tu-eq "ks-normalize-name/ks-aus" "KS_AUS" (ks-normalize-name "KS_AUS"))
|
|
(tu-nil "ks-normalize-name/kein-ks" (ks-normalize-name "IRGENDWAS"))
|
|
|
|
(tu-eq "ks-line-axis/X-1" "X" (ks-line-axis 1.0))
|
|
(tu-eq "ks-line-axis/X-100" "X" (ks-line-axis 100.0))
|
|
(tu-eq "ks-line-axis/Y" "Y" (ks-line-axis 2.0))
|
|
(tu-eq "ks-line-axis/Z" "Z" (ks-line-axis 3.0))
|
|
|
|
(tu-eq "fmt/zahl" "3.14" (fmt 3.14159))
|
|
(tu-eq "fmt/nil" "---" (fmt nil))
|
|
|
|
;; hz-winkel->xu: Richtungsvektor aus Horizontal-/Vertikalwinkel
|
|
(tu-eqf "hz-winkel->xu/0-0" '(1.0 0.0 0.0) (hz-winkel->xu 0 0))
|
|
(tu-eqf "hz-winkel->xu/90-0" '(0.0 1.0 0.0) (hz-winkel->xu 90 0))
|
|
|
|
;; Roundtrip frame -> (hz winkel)
|
|
(tu-eqf "frame->hz-winkel/roundtrip"
|
|
'(30.0 10.0)
|
|
(frame->hz-winkel (punkt-hz-winkel->frame '(0.0 0.0 0.0) 30 10)))
|
|
|
|
;; ks-relativize / ks-absolutize sind zueinander invers
|
|
(setq _ks '(("KS_EIN" ((100.0 200.0 300.0) (101.0 200.0 300.0)))))
|
|
(tu-eqf "ks-relativize+absolutize/invers"
|
|
_ks
|
|
(ks-absolutize (ks-relativize _ks '(10.0 20.0 30.0)) '(10.0 20.0 30.0)))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TESTS: export.lsp - CSV/KOS-Kodierung
|
|
;; ------------------------------------------------------------
|
|
;; Hilfsfunktion der csv:sepliste-paare-Tests: nur (lfdnr index) vergleichen,
|
|
;; nicht den Fliesskomma-Abstand. Bewusst auf Top-Level (nicht im Testblock):
|
|
;; per defun IN einem Testblock definierte Funktionen sind in BricsCAD im
|
|
;; laufenden Durchlauf nicht zuverlaessig gebunden (siehe Ladearchitektur oben).
|
|
(defun tu-paare (e p)
|
|
(mapcar (function (lambda (x) (list (nth 0 x) (nth 1 x))))
|
|
(csv:sepliste-paare e p))
|
|
)
|
|
|
|
(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-paare: sepliste-Eintrag <-> ausgepackte Kopie ---------
|
|
;; Reine Rechenfunktion (Eintraege + Kopien rein, (lfdnr index abstand)
|
|
;; raus) - hier ohne Zeichnung testbar. Im Export liefert
|
|
;; csv:sepliste-ids-setzen die Kopien in Erzeugungsreihenfolge; nur der
|
|
;; Index zaehlt, darum vergleichen die Tests (lfdnr index) statt der
|
|
;; Fliesskomma-Abstaende.
|
|
(tu-eq "csv:sepliste-paare/leer" nil (csv:sepliste-paare nil nil))
|
|
|
|
;; Gerade Kette AS -> SEP -> SEP -> ES; Kopien bewusst in anderer
|
|
;; Reihenfolge als die sepliste (die Erzeugungsreihenfolge der Kopien folgt
|
|
;; der Blockdefinition, nicht der Bauabfolge).
|
|
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 1000.0 0.0) ("SEP" 3 2000.0 0.0) ("ES" 4 3000.0 0.0)))
|
|
(setq _p '(("SEP" 2000.0 0.0) ("AS" 0.0 0.0) ("ES" 3000.0 0.0) ("SEP" 1000.0 0.0)))
|
|
(tu-eq "csv:sepliste-paare/kette" '((1 1) (2 3) (3 0) (4 2)) (tu-paare _e _p))
|
|
|
|
;; EIN fehlerhafter Koordinatenwert (bekannter Fehlerfall: gespiegeltes x
|
|
;; bei lfdnr=2) darf die uebrigen Zuordnungen nicht verschieben - die
|
|
;; exklusive Vergabe teilt dem fehlerhaften Eintrag den Rest zu.
|
|
(setq _e '(("SEP" 1 1000.0 0.0) ("SEP" 2 -1000.0 -5000.0) ("SEP" 3 3000.0 0.0)))
|
|
(setq _p '(("SEP" 1000.0 0.0) ("SEP" 2000.0 0.0) ("SEP" 3000.0 0.0)))
|
|
(tu-eq "csv:sepliste-paare/gespiegelte-koordinate" '((1 0) (2 1) (3 2)) (tu-paare _e _p))
|
|
|
|
;; Gleiche Abstaende duerfen kein Paar verschlucken: vl-sort wirft
|
|
;; Elemente weg, die unter der Vergleichsfunktion gleich sind - deshalb
|
|
;; sortiert csv:sepliste-paare nach (Abstand, lfdnr, Index).
|
|
(setq _e '(("SEP" 1 0.0 0.0) ("SEP" 2 0.0 0.0)))
|
|
(setq _p '(("SEP" 0.0 0.0) ("SEP" 0.0 0.0)))
|
|
(tu-eq "csv:sepliste-paare/gleiche-abstaende" '((1 0) (2 1)) (tu-paare _e _p))
|
|
|
|
;; Typ trennt: eine AS-Kopie wird nie einem SEP-Eintrag zugeteilt, der
|
|
;; SEP-Eintrag bleibt ohne Partner (und im Export ohne ID).
|
|
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 10.0 0.0)))
|
|
(setq _p '(("AS" 5.0 0.0)))
|
|
(tu-eq "csv:sepliste-paare/typ-trennt" '((1 0)) (tu-paare _e _p))
|
|
|
|
;; --- 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:proxy-typ: Typmarker aus dem Blocknamen (Grundlage der Zuordnung).
|
|
(tu-eq "csv:proxy-typ/as" "AS" (csv:proxy-typ "AS_Element_90_links_3D"))
|
|
(tu-eq "csv:proxy-typ/es" "ES" (csv:proxy-typ "ES_Element_30_rechts_2D"))
|
|
(tu-eq "csv:proxy-typ/sep" "SEP" (csv:proxy-typ "Separator_SP_3D"))
|
|
|
|
;; 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:sepliste-partition: sepliste in Foerdereinheit-/Gefaelleeinheit-
|
|
;; Spannen aufteilen (Lauflaengen-Kodierung ueber den effektiven Typ) -----
|
|
;; Reine Rechenfunktion auf (typ lfdnr strecke-typ welt-pt)-Tupeln, hier
|
|
;; ohne Zeichnung testbar (welt-pt wird von der Partitionierung selbst
|
|
;; nicht gebraucht, darum ueberall nil).
|
|
|
|
;; HundM05 VF_1-Beispiel (echt verifiziert): AS, SEP2=VF, SEP3=GF, SEP4=GF,
|
|
;; SEP5=VF, ES -> 3 Einheiten VF,GF,VF. SEP3+SEP4 bracketen GEMEINSAM eine
|
|
;; einzige Gefaelleeinheit (nicht zwei separate).
|
|
(setq _sep-hundm05
|
|
'(("AS" 1 nil nil) ("SEP" 2 "VF" nil) ("SEP" 3 "GF" nil)
|
|
("SEP" 4 "GF" nil) ("SEP" 5 "VF" nil) ("ES" 6 nil nil)))
|
|
(tu-eq "csv:sepliste-partition/hundm05"
|
|
'(("VF" (1 2)) ("GF" (3 4)) ("VF" (5 6)))
|
|
(csv:sepliste-partition _sep-hundm05))
|
|
|
|
;; Minimalfall: nur AS-SEP(VF)-ES, kein Typwechsel -> 1 Foerdereinheit ueber
|
|
;; die ganze Kette.
|
|
(setq _sep-minimal '(("AS" 1 nil nil) ("SEP" 2 "VF" nil) ("ES" 3 nil nil)))
|
|
(tu-eq "csv:sepliste-partition/minimal"
|
|
'(("VF" (1 2 3)))
|
|
(csv:sepliste-partition _sep-minimal))
|
|
|
|
;; Einzel-GF-Fall: die Gefaelleeinheit wird nur von EINEM SEP (nicht zwei)
|
|
;; UND dem nachfolgenden ES bracketiert.
|
|
(setq _sep-einzel-gf
|
|
'(("AS" 1 nil nil) ("SEP" 2 "VF" nil) ("SEP" 3 "GF" nil) ("ES" 4 nil nil)))
|
|
(tu-eq "csv:sepliste-partition/einzel-gf"
|
|
'(("VF" (1 2)) ("GF" (3 4)))
|
|
(csv:sepliste-partition _sep-einzel-gf))
|
|
|
|
;; 3+ gleichtypige SEP-Eintraege hintereinander muessen weiterhin EINE
|
|
;; Einheit ergeben (nicht mehrere) - Lauflaengen-Regel, kein Sonderfall.
|
|
(setq _sep-dreifach-gf
|
|
'(("AS" 1 nil nil) ("SEP" 2 "VF" nil) ("SEP" 3 "GF" nil)
|
|
("SEP" 4 "GF" nil) ("SEP" 5 "GF" nil) ("SEP" 6 "VF" nil) ("ES" 7 nil nil)))
|
|
(tu-eq "csv:sepliste-partition/dreifach-gf"
|
|
'(("VF" (1 2)) ("GF" (3 4 5)) ("VF" (6 7)))
|
|
(csv:sepliste-partition _sep-dreifach-gf))
|
|
|
|
;; Kette beginnend mit GF (AS erbt den Typ des ersten SEP-Eintrags, hier GF
|
|
;; statt des sonstigen Default "VF").
|
|
(setq _sep-startet-gf
|
|
'(("AS" 1 nil nil) ("SEP" 2 "GF" nil) ("ES" 3 nil nil)))
|
|
(tu-eq "csv:sepliste-partition/startet-gf"
|
|
'(("GF" (1 2 3)))
|
|
(csv:sepliste-partition _sep-startet-gf))
|
|
|
|
;; --- csv:dot2: 2D-Skalarprodukt ---
|
|
(tu-eqf "csv:dot2/achsen" 0.0 (csv:dot2 '(1.0 0.0) '(0.0 1.0)))
|
|
(tu-eqf "csv:dot2/parallel" 6.0 (csv:dot2 '(2.0 0.0) '(3.0 0.0)))
|
|
|
|
;; --- csv:element-unit-zuordnung: Elemente per Kettenrichtungs-Projektion
|
|
;; den Einheiten-Spannen zuordnen und INNERHALB jeder Spanne nach der
|
|
;; Projektion sortieren -----------------------------------------------
|
|
;; Gerade Kette AS(0,0) -SEP2(VF, 10,0)- SEP3(GF, 20,0) -ES(30,0)- entlang
|
|
;; der X-Achse. unit-spans: VF=[1,2], GF=[2,3] (SEP2 gehoert zu beiden
|
|
;; Spannen als Grenzmarker, siehe csv:sepliste-partition).
|
|
(setq _sep-proj
|
|
'(("AS" 1 nil (0.0 0.0 0.0)) ("SEP" 2 "VF" (10.0 0.0 0.0))
|
|
("SEP" 3 "GF" (20.0 0.0 0.0)) ("ES" 4 nil (30.0 0.0 0.0))))
|
|
(setq _spans-proj (csv:sepliste-partition _sep-proj))
|
|
(tu-eq "csv:sepliste-partition/proj-spans" '(("VF" (1 2)) ("GF" (3 4))) _spans-proj)
|
|
;; Zwei Elemente: eines bei x=5 (klar in der VF-Spanne [0,10]), eines bei
|
|
;; x=17 (in der Luecke zwischen den Spannen-Grenzpunkten [10,20], aber
|
|
;; naeher an der GF-Grenze 20 als an der VF-Grenze 10 - eindeutig GF, kein
|
|
;; Gleichstand wie bei x=15 in der Luecken-Mitte).
|
|
(setq _elem-vf (list 'PROXY1 'WRAPPER "STRECKENELEMENT" '(5.0 0.0 0.0)))
|
|
(setq _elem-gf (list 'PROXY2 'WRAPPER "STRECKENELEMENT" '(17.0 0.0 0.0)))
|
|
(setq _zuord (csv:element-unit-zuordnung _spans-proj _sep-proj (list _elem-vf _elem-gf)))
|
|
(tu-eq "csv:element-unit-zuordnung/vf-treffer" (list _elem-vf) (nth 0 _zuord))
|
|
(tu-eq "csv:element-unit-zuordnung/gf-treffer" (list _elem-gf) (nth 1 _zuord))
|
|
|
|
;; Sortierung innerhalb einer Spanne: zwei Elemente in der VF-Spanne,
|
|
;; absichtlich in "falscher" Reihenfolge uebergeben - das Ergebnis muss
|
|
;; nach x sortiert sein (frueheres x zuerst).
|
|
(setq _elem-a (list 'PROXY_A 'WRAPPER "BOGEN" '(8.0 0.0 0.0)))
|
|
(setq _elem-b (list 'PROXY_B 'WRAPPER "BOGEN" '(2.0 0.0 0.0)))
|
|
(setq _zuord2 (csv:element-unit-zuordnung _spans-proj _sep-proj (list _elem-a _elem-b)))
|
|
(tu-eq "csv:element-unit-zuordnung/sortiert" (list _elem-b _elem-a) (nth 0 _zuord2))
|
|
|
|
;; --- 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.
|
|
(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)
|