Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
4fdeaf831fc5b103f7d87f0fbbe05c7a8898dec6
dxfmakros/tests/test_unit.lsp
T

2315 lines
122 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_unit.lsp - Unit-Tests fuer einfache LISP-Standardfunktionen
;;
;; Testet reine Hilfsfunktionen (String, Zahl, Vektor, Liste,
;; Alist), die OHNE Zeichnungsdatenbank, Auswahlsaetze, Dialoge
;; oder Blockdateien auskommen - analog zu den Python-Unittests,
;; nur direkt in AutoLISP formuliert. Jeder Testfall vergleicht
;; einen Funktionsaufruf gegen ein erwartetes Ergebnis.
;;
;; Aufruf in BricsCAD (SSG_LIB muss geladen sein):
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
;; TEST_UNIT
;;
;; Ueber die Kommandozeile:
;; bin\run_tests.bat --lisp
;; (startet BricsCAD mit tests/output/_unit_run.scr, laedt SSG_LIB,
;; fuehrt TEST_UNIT aus und schreibt tests/output/unit_results.txt)
;;
;; Ergebnis:
;; Konsole: PASS/FAIL je Test + Zusammenfassung
;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen)
;;
;; 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)
;; --- DCL-Vorlagen: Platzhalterzeilen //@NAME@ ersetzen ---
(tu-eq "ssg-dcl-zeilen-ersetzen/ersetzt"
'("a {" " x;" " y;" "}")
(ssg-dcl-zeilen-ersetzen '("a {" " //@L@" "}") '(("L" " x;" " y;"))))
(tu-eq "ssg-dcl-zeilen-ersetzen/leer-entfernt"
'("a {" "}")
(ssg-dcl-zeilen-ersetzen '("a {" "\t//@L@ " "}") '(("L"))))
(tu-eq "ssg-dcl-zeilen-ersetzen/mehrere"
'("1" "2")
(ssg-dcl-zeilen-ersetzen '("//@A@" "//@B@") '(("A" "1") ("B" "2"))))
;; unbekannter Marker und normaler Kommentar bleiben stehen
(tu-eq "ssg-dcl-zeilen-ersetzen/unbekannt"
'("//@X@" "// Kommentar")
(ssg-dcl-zeilen-ersetzen '("//@X@" "// Kommentar") '(("A" "1"))))
)
;; ------------------------------------------------------------
;; TESTS: ssg_lang.lsp - Textersetzung
;; ------------------------------------------------------------
(defun tu-tests-lang ()
(princ "\n[ssg_lang]")
;; ssg-str-replace-all: (neu alt str)
(tu-eq "ssg-str-replace-all/alle" "fXX" (ssg-str-replace-all "X" "o" "foo"))
(tu-eq "ssg-str-replace-all/mehrfach" "a-b-c" (ssg-str-replace-all "-" "." "a.b.c"))
(tu-eq "ssg-str-replace-all/keins" "abc" (ssg-str-replace-all "X" "z" "abc"))
;; ssg-lang-unescape: literales \n (Backslash+n) -> echter Zeilenumbruch
(setq _u (ssg-lang-unescape (strcat "a" "\\n" "b")))
(tu-eq "ssg-lang-unescape/laenge" 3 (strlen _u))
(tu-eq "ssg-lang-unescape/newline" (chr 10) (substr _u 2 1))
)
;; ------------------------------------------------------------
;; TESTS: ssg_id.lsp - ID-Formatierung
;; ------------------------------------------------------------
(defun tu-tests-id ()
(princ "\n[ssg_id]")
(tu-eq "ssg-id-format/1" "0001" (ssg-id-format 1))
(tu-eq "ssg-id-format/42" "0042" (ssg-id-format 42))
(tu-eq "ssg-id-format/1000" "1000" (ssg-id-format 1000))
(tu-eq "ssg-id-format/12345" "12345" (ssg-id-format 12345))
;; Reservierte IDs (XDATA SSG_ID_RES): Serialisierung + Maximum.
(setq _rp '(("AS|1" . "0032") ("ES|4" . "0107")))
(tu-eq "ssg-id-res->strings" '("AS|1=0032" "ES|4=0107") (ssg-id-res->strings _rp))
(tu-eq "ssg-id-res-parse/rundlauf" _rp (ssg-id-res-parse (ssg-id-res->strings _rp)))
(tu-eq "ssg-id-res-parse/ohne-gleich-ignoriert" '(("AS|1" . "0032"))
(ssg-id-res-parse '("kaputt" "AS|1=0032")))
(tu-eq "ssg-id-res-parse/leerer-wert" '(("AS|1" . "")) (ssg-id-res-parse '("AS|1=")))
(tu-eq "ssg-id-res-max" 107 (ssg-id-res-max _rp))
(tu-eq "ssg-id-res-max/leer" 0 (ssg-id-res-max nil))
)
;; ------------------------------------------------------------
;; TESTS: vf_core.lsp - Vektor-/Frame-Mathematik
;; ------------------------------------------------------------
(defun tu-tests-vfcore ()
(princ "\n[vf_core]")
(tu-eqf "vec-length/3-4-0" 5.0 (vec-length '(3.0 4.0 0.0)))
(tu-eqf "vec3-cross/x-cross-y" '(0.0 0.0 1.0) (vec3-cross '(1.0 0.0 0.0) '(0.0 1.0 0.0)))
(tu-eqf "vec3-cross/z-cross-x" '(0.0 1.0 0.0) (vec3-cross '(0.0 0.0 1.0) '(1.0 0.0 0.0)))
(tu-eqf "vec3-normalize/z5" '(0.0 0.0 1.0) (vec3-normalize '(0.0 0.0 5.0)))
(tu-eqf "mat3-mul-vec3/identitaet"
'(2.0 3.0 4.0)
(mat3-mul-vec3 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) '(2.0 3.0 4.0)))
(tu-eqf "punkt-differenz" '(3.0 4.0 5.0) (punkt-differenz '(1.0 1.0 1.0) '(4.0 5.0 6.0)))
(tu-eq "ks-normalize-name/ksys-ein" "KS_EIN" (ks-normalize-name "KSYS_EIN"))
(tu-eq "ks-normalize-name/ks-aus" "KS_AUS" (ks-normalize-name "KS_AUS"))
(tu-nil "ks-normalize-name/kein-ks" (ks-normalize-name "IRGENDWAS"))
(tu-eq "ks-line-axis/X-1" "X" (ks-line-axis 1.0))
(tu-eq "ks-line-axis/X-100" "X" (ks-line-axis 100.0))
(tu-eq "ks-line-axis/Y" "Y" (ks-line-axis 2.0))
(tu-eq "ks-line-axis/Z" "Z" (ks-line-axis 3.0))
(tu-eq "fmt/zahl" "3.14" (fmt 3.14159))
(tu-eq "fmt/nil" "---" (fmt nil))
;; hz-winkel->xu: Richtungsvektor aus Horizontal-/Vertikalwinkel
(tu-eqf "hz-winkel->xu/0-0" '(1.0 0.0 0.0) (hz-winkel->xu 0 0))
(tu-eqf "hz-winkel->xu/90-0" '(0.0 1.0 0.0) (hz-winkel->xu 90 0))
;; Roundtrip frame -> (hz winkel)
(tu-eqf "frame->hz-winkel/roundtrip"
'(30.0 10.0)
(frame->hz-winkel (punkt-hz-winkel->frame '(0.0 0.0 0.0) 30 10)))
;; ks-relativize / ks-absolutize sind zueinander invers
(setq _ks '(("KS_EIN" ((100.0 200.0 300.0) (101.0 200.0 300.0)))))
(tu-eqf "ks-relativize+absolutize/invers"
_ks
(ks-absolutize (ks-relativize _ks '(10.0 20.0 30.0)) '(10.0 20.0 30.0)))
)
;; ------------------------------------------------------------
;; TESTS: vf_etage.lsp - Projektion der Randstuecke auf die Hauptachse
;; ------------------------------------------------------------
;; etage-laengs/-quer zerlegen einen um d gedreht eingebauten Blockvektor
;; (vx vy) in Laengs- und Queranteil bezogen auf die Hauptachse. Sie sind der
;; Kern von etage-rand-budget und damit der korrigierten Laengenbilanz.
(defun tu-tests-etage ( / _hp _vx _vy _l _q)
(princ "\n[vf_etage]")
(setq _hp (/ pi 2.0))
;; d=0: Block liegt schon auf der Hauptachse -> unveraendert
(tu-eqf "etage-laengs/d0" 250.0 (etage-laengs 250.0 67.0 0.0))
(tu-eqf "etage-quer/d0" 67.0 (etage-quer 250.0 67.0 0.0))
;; d=+90 Grad: Block-X zeigt quer, Block-Y entgegen der Hauptachse
(tu-eqf "etage-laengs/d+90" -67.0 (etage-laengs 250.0 67.0 _hp))
(tu-eqf "etage-quer/d+90" 250.0 (etage-quer 250.0 67.0 _hp))
;; REGRESSION (Nutzer-Befund 2026-10-09): das AS_Element_30 hat ein-ang=90
;; Grad, wird also mit d=-90 Grad eingebaut. Auf der Hauptachse landet dann
;; die Block-Y-Komponente (486.1), NICHT die Block-X-Komponente (209.7).
;; Der alte Solver nahm vx und verfehlte die Kettenlaenge um ~990 mm.
(tu-eqf "etage-laengs/AS-d-90-nimmt-vy" 486.1 (etage-laengs 209.7 486.1 (- _hp)))
(tu-eqf "etage-quer/AS-d-90" -209.7 (etage-quer 209.7 486.1 (- _hp)))
;; dito ES_Element_30 (ein-ang=120, Auslauf-Schwenk 30 -> d=-90)
(tu-eqf "etage-laengs/ES-d-90-nimmt-vy" 525.29 (etage-laengs -242.6 525.29 (- _hp)))
(tu-eqf "etage-quer/ES-d-90" 242.6 (etage-quer -242.6 525.29 (- _hp)))
;; Drehung ist laengentreu: laengs^2 + quer^2 = vx^2 + vy^2 (fuer jedes d)
(setq _vx 209.7 _vy 486.1)
(setq _l (etage-laengs _vx _vy 0.9) _q (etage-quer _vx _vy 0.9))
(tu-eqf "etage-laengs/quer-laengentreu"
(+ (* _vx _vx) (* _vy _vy))
(+ (* _l _l) (* _q _q)))
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - ES-Fussabdruck entlang der Fahrtrichtung
;; ------------------------------------------------------------
;; vfl-es-laengs liefert die Laenge, die ein Segment fuer das ES-Element
;; reservieren muss. Getestet wird die Rueckfallkette: ohne sie wuerde ein
;; fehlender Messwert zu (- deltaL nil) und damit zum Absturz fuehren.
(defun tu-tests-vfl-es ( / _s-laengs _s-dx)
(princ "\n[vf_linienzug ES]")
;; globale Masse sichern - sie gehoeren dem laufenden Bau-Kontext
(setq _s-laengs ein-laengs _s-dx ein-dx)
;; Normalfall: ein-laengs ist gesetzt und wird genommen.
;; 576.2 = ES_Element_30_rechts entlang der Fahrtrichtung; (abs ein-dx)
;; waere 242.6 - genau die 333.65 mm, um die die Kette frueher zu weit ragte.
(setq ein-laengs 576.2 ein-dx -242.6)
(tu-eqf "vfl-es-laengs/nimmt-laengs-nicht-dx" 576.2 (vfl-es-laengs))
;; Vorzeichen: reserviert wird immer ein Betrag
(setq ein-laengs -576.2)
(tu-eqf "vfl-es-laengs/betrag" 576.2 (vfl-es-laengs))
;; Genulltes ein-dx gewinnt: die Null-Konvention der Bau-Pfade bedeutet
;; "ES anderswo schon beruecksichtigt - hier nichts reservieren". Ohne diese
;; Kopplung wuerde der Fix einen doppelten Abzug einbauen.
(setq ein-laengs 576.2 ein-dx 0.0)
(tu-eqf "vfl-es-laengs/genulltes-dx-gewinnt" 0.0 (vfl-es-laengs))
;; KS nicht lesbar -> Rueckfall auf das alte (zu kleine) Blockmass
(setq ein-laengs nil ein-dx -242.6)
(tu-eqf "vfl-es-laengs/fallback-auf-dx" 242.6 (vfl-es-laengs))
;; gar nichts gemessen -> 0.0, niemals nil (Absturzschutz)
(setq ein-dx nil)
(tu-eqf "vfl-es-laengs/fallback-null" 0.0 (vfl-es-laengs))
(setq ein-laengs _s-laengs ein-dx _s-dx)
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - Laenge aus einer Ziellinie (X/Y)
;; ------------------------------------------------------------
;; Steht die Fahrtrichtung fest, ist die Laenge nicht mehr frei: die (ggf.
;; seitlich versetzte) Bahn trifft die Ziellinie in genau einem Punkt.
;; REIN PLANAR - die Hoehe kommt weiterhin aus dem Gefaellewinkel.
(defun tu-tests-vfl-ziellinie ( / _p0 _l _ks)
(princ "\n[vf_linienzug Ziellinie]")
(tu-eqf "vfl-kreuz2/einheitsachsen" 1.0 (vfl-kreuz2 1.0 0.0 0.0 1.0))
(tu-eqf "vfl-kreuz2/parallel" 0.0 (vfl-kreuz2 2.0 4.0 1.0 2.0))
(setq _p0 '(0.0 0.0 0.0))
;; Fahrtrichtung 0 Grad, senkrechte Ziellinie bei x=1000 -> L=1000
(tu-eqf "vfl-laenge-bis-ziellinie/senkrecht"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(1000.0 -500.0 0.0) '(1000.0 500.0 0.0)))
;; Querversatz verschiebt die BAHN seitlich, nicht laengs: bei einer zur
;; Fahrtrichtung senkrechten Ziellinie bleibt L deshalb gleich.
(tu-eqf "vfl-laenge-bis-ziellinie/querversatz-ohne-wirkung"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 52.5 '(1000.0 -500.0 0.0) '(1000.0 500.0 0.0)))
;; 45-Grad-Ziellinie durch (1000,0): die um +100 versetzte Bahn trifft sie
;; 100 frueher (y=100 wird bei x=1100 erreicht -> ohne Versatz 1000+100).
(tu-eqf "vfl-laenge-bis-ziellinie/schraege-linie"
1100.0 (vfl-laenge-bis-ziellinie _p0 0.0 100.0 '(1000.0 0.0 0.0) '(2000.0 1000.0 0.0)))
;; Ziellinie PARALLEL zur Fahrtrichtung -> kein eindeutiger Treffer -> nil
(tu-nil "vfl-laenge-bis-ziellinie/parallel"
(vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(0.0 500.0 0.0) '(1000.0 500.0 0.0)))
;; Z der Ziellinie ist irrelevant (rein planare Rechnung, Nutzer-Vorgabe):
;; dieselbe Linie auf anderer Hoehe liefert dasselbe L.
(tu-eqf "vfl-laenge-bis-ziellinie/z-ignoriert"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(1000.0 -500.0 7777.0) '(1000.0 500.0 -99.0)))
;; Realfall aus dem Nutzer-Log: nach dem 30-Grad-Bogen steht die Kette bei
;; (901.21,-2728.97) mit hz=-120; das ES-KS_AUS laeuft 52.51 mm versetzt und
;; landete bei (231.42,-3994.11). Eine Ziellinie durch diesen Punkt quer zur
;; Fahrtrichtung muss genau die damals gebaute Gesamtlaenge liefern.
(setq _ks '(231.42 -3994.11 0.0))
(setq _l (vfl-laenge-bis-ziellinie '(901.21 -2728.97 0.0) -120.0 52.51
_ks (list (+ (car _ks) (cos (/ pi 6.0))) ; 30 Grad = quer zu -120
(+ (cadr _ks) (sin (/ pi 6.0))) 0.0)))
(tu-true "vfl-laenge-bis-ziellinie/realfall-plausibel"
(and _l (> _l 1430.0) (< _l 1431.0)))
)
;; ------------------------------------------------------------
;; TESTS: export.lsp - CSV/KOS-Kodierung
;; ------------------------------------------------------------
(defun tu-tests-export ()
(princ "\n[export]")
(tu-eq "csv:clamp/innen" 5 (csv:clamp 5 0 10))
(tu-eq "csv:clamp/unten" 0 (csv:clamp -3 0 10))
(tu-eq "csv:clamp/oben" 10 (csv:clamp 20 0 10))
(tu-eqf "csv:z-angle-to-quat/0" '(0.0 0.0 0.0 1.0) (csv:z-angle-to-quat 0))
(tu-eqf "csv:z-angle-to-quat/180" '(0.0 0.0 1.0 0.0) (csv:z-angle-to-quat 180))
(tu-eq "csv:b64-encode-ints/0" "AAAA" (csv:b64-encode-ints '(0)))
(tu-eq "csv:trans-encode/0-0-0" "AAAAAAAAAAAA" (csv:trans-encode 0.0 0.0 0.0))
;; local-to-world: Eltern-Orientierung als 3x3-Rotationsmatrix (mat3-rz
;; liefert die Z-Drehmatrix aus dem Winkel - Signatur seit dem
;; Extrusions-Fix in export.lsp: parent-R statt parent-rot-rad).
(tu-eqf "csv:local-to-world/keine-drehung"
'(1.0 0.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (mat3-rz 0.0) '(1.0 0.0 0.0)))
(tu-eqf "csv:local-to-world/90-grad"
'(0.0 1.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (mat3-rz (/ pi 2.0)) '(1.0 0.0 0.0)))
;; json-escape: Anfuehrungszeichen maskieren
(tu-eq "csv:json-escape/quote" "a\\\"b" (csv:json-escape "a\"b"))
;; --- csv:sepliste-kette-paare: sepliste-Eintrag <-> Kettenbaustein -------
;; Zuordnung ueber die Reihenfolge je Typ (k-tes AS/SEP/ES der sepliste =
;; k-tes der geordneten Kette), Rueckgabe ((lfdnr . index) ...).
(tu-nil "csv:sepliste-kette-paare/leer" (csv:sepliste-kette-paare nil nil))
;; HundM05-artige Kette: Koordinaten spielen keine Rolle (auch gespiegelte
;; x-Werte aendern nichts), Bausteine ohne sepliste-Typ werden uebersprungen.
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 -9999.0 0.0) ("SEP" 3 2000.0 0.0) ("ES" 4 3000.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/kette"
'((1 . 0) (2 . 2) (3 . 5) (4 . 7))
(csv:sepliste-kette-paare _e
'("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "MOTORSTATION" "SEP" "BOGEN" "ES")))
;; lfdnr-Reihenfolge zaehlt, nicht die Reihenfolge der Eintraege in der Liste.
(setq _e '(("SEP" 3 0.0 0.0) ("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/unsortiert"
'((1 . 0) (2 . 1) (3 . 2))
(csv:sepliste-kette-paare _e '("AS" "SEP" "SEP")))
;; Mehr Eintraege als Bausteine: die ueberzaehligen bleiben ohne Partner.
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0) ("SEP" 3 0.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/fehlender-baustein"
'((1 . 0) (2 . 2))
(csv:sepliste-kette-paare _e '("AS" "BOGEN" "SEP" "ES")))
;; --- csv:asmark-finden: bisherigen AS/ES-Marker im Bestand wiederfinden ---
;; Schluessel ist (Wrapper-ID, Typ, lfdnr) - alle drei muessen passen, sonst
;; bekaeme ein Kettenende die ID eines fremden Markers. Bestandsformat:
;; (ename zuordnung typ lfdnr id), siehe csv:asmark-sammeln.
(setq _mk '((ME1 "0021" "AS" "1" "0031")
(ME2 "0021" "ES" "4" "0032")
(ME3 "0022" "AS" "1" "0033")))
(tu-eq "csv:asmark-finden/treffer"
'(ME2 "0021" "ES" "4" "0032") (csv:asmark-finden _mk "0021" "ES" "4"))
(tu-eq "csv:asmark-finden/anderer-wrapper"
'(ME3 "0022" "AS" "1" "0033") (csv:asmark-finden _mk "0022" "AS" "1"))
(tu-nil "csv:asmark-finden/falsche-lfdnr" (csv:asmark-finden _mk "0021" "AS" "2"))
(tu-nil "csv:asmark-finden/falscher-typ" (csv:asmark-finden _mk "0021" "SEP" "1"))
(tu-nil "csv:asmark-finden/ohne-wrapper-id" (csv:asmark-finden _mk "" "AS" "1"))
(tu-nil "csv:asmark-finden/leerer-bestand" (csv:asmark-finden nil "0021" "AS" "1"))
;; csv:asmark-res-key: Schluessel der reservierten ID am Wrapper - lfdnr als
;; Integer (csv:asmark-aktualisieren) und String muss denselben liefern.
(tu-eq "csv:asmark-res-key/int" "AS|1" (csv:asmark-res-key "AS" 1))
(tu-eq "csv:asmark-res-key/str" "ES|4" (csv:asmark-res-key "ES" "4"))
(tu-eq "csv:res-key-kette" "K|7" (csv:res-key-kette 7))
(tu-eq "csv:res-key-einheit" "U|2" (csv:res-key-einheit 2))
;; csv:res-merken: Anmeldungen je Wrapper zusammenfuehren (ein Eintrag je
;; Wrapper, Reihenfolge der Anmeldung). Symbole statt enames - rein
;; listenbasiert. Globale Sammlung sichern und wiederherstellen.
(setq _rs *csv-res-sammlung* *csv-res-sammlung* nil)
(csv:res-merken 'W1 "AS|1" 'M1)
(csv:res-merken 'W2 "K|0" 'M2)
(csv:res-merken 'W1 "K|3" 'M3)
(tu-eq "csv:res-merken/je-wrapper"
'((W1 ("AS|1" . M1) ("K|3" . M3)) (W2 ("K|0" . M2)))
(vl-sort *csv-res-sammlung* (function (lambda (a b) (< (vl-symbol-name (car a))
(vl-symbol-name (car b)))))))
(setq *csv-res-sammlung* _rs)
;; csv:pattern-nested-element: Suchmuster = alle Familienmuster aus
;; csv:element-familien - jede Familie ist also auch klassifizierbar.
(tu-eq "csv:pattern-nested-element/aus-familien"
(ssg-join (mapcar 'cdr (csv:element-familien)) ",")
(csv:pattern-nested-element))
(tu-true "csv:element-familien/jedes-muster-klassifiziert"
(not (vl-some (function (lambda (f)
(not (equal (car f) (csv:element-teileart
(vl-string-subst "X" "*"
(substr (cdr f) 1 (cond ((vl-string-search "," (cdr f)))
((strlen (cdr f)))))))))))
(csv:element-familien))))
;; csv:element-teileart: TeileArt-Familie eines ausgepackten VF_n/GF_n-
;; Bausteins aus dem Blocknamen (Boegen/Streckenelement/Umlenk-/Motor-
;; station). Vario_Bogen_* deckt sowohl die _TEF_- als auch die reine
;; GF-Variante ab, beide auf denselben Bucket "BOGEN".
(tu-eq "csv:element-teileart/gefaellebogen" "BOGEN"
(csv:element-teileart "Gefaellebogen_links_90_R500"))
(tu-eq "csv:element-teileart/vario-bogen-tef" "BOGEN"
(csv:element-teileart "Vario_Bogen_auf_3_TEF_rechts"))
(tu-eq "csv:element-teileart/vario-bogen-gf" "BOGEN"
(csv:element-teileart "Vario_Bogen_ab_6_rechts"))
(tu-eq "csv:element-teileart/vario-kurve" "BOGEN"
(csv:element-teileart "Vario_Kurve_links_30_TEF_innen"))
(tu-eq "csv:element-teileart/streckenelement" "STRECKENELEMENT"
(csv:element-teileart "Staustrecke_SP_1000_mm"))
(tu-eq "csv:element-teileart/umlenkstation" "UMLENKSTATION"
(csv:element-teileart "Vario_Umlenkstation_500mm_links"))
(tu-eq "csv:element-teileart/motorstation" "MOTORSTATION"
(csv:element-teileart "Vario_Motorstation_500mm_rechts"))
(tu-eq "csv:element-teileart/unbekannt" nil
(csv:element-teileart "AS_Element_90_links"))
;; --- csv:kette-typ: Bausteintyp einer VF_n/GF_n-Kette aus dem Blocknamen --
(tu-eq "csv:kette-typ/as" "AS" (csv:kette-typ "AS_Element_90_links_3D"))
(tu-eq "csv:kette-typ/es" "ES" (csv:kette-typ "ES_Element_30_rechts_2D"))
(tu-eq "csv:kette-typ/sep" "SEP" (csv:kette-typ "Staustrecke_Separator_SP_300_mm_3D"))
(tu-eq "csv:kette-typ/streckenelement" "STRECKENELEMENT"
(csv:kette-typ "Staustrecke_SP_1000_mm_3D"))
(tu-eq "csv:kette-typ/umlenk" "UMLENKSTATION"
(csv:kette-typ "Vario_Umlenkstation_500mm_rechts_3D"))
(tu-nil "csv:kette-typ/symbol-ist-kein-baustein" (csv:kette-typ "Separator_SP_3D"))
;; --- csv:kette-einheiten: geordnete Typfolge in VF-/GF-Einheiten schneiden
;; VF = Separator vor der Umlenkstation ... Motorstation; alles dazwischen
;; GF; AS/ES gehoeren zu keiner Einheit. Reine Rechenfunktion.
;; HundM05 VF_5 (Bausteinfolge aus der Testzeichnung, per KS-Kette geordnet):
;; GF(1) VF(2..10) GF(11 12) VF(13..25) GF(26 27) - passt zu L_GF_m
;; "0.727,0.201,0.318" des Wrappers (drei Gefaelleabschnitte).
(setq _kette-hundm05
'("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT"
"BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "MOTORSTATION" "SEP"
"STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT" "BOGEN"
"BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN"
"MOTORSTATION" "STRECKENELEMENT" "SEP" "ES"))
(tu-eq "csv:kette-einheiten/hundm05"
'(("GF" (1)) ("VF" (2 3 4 5 6 7 8 9 10)) ("GF" (11 12))
("VF" (13 14 15 16 17 18 19 20 21 22 23 24 25)) ("GF" (26 27)))
(csv:kette-einheiten _kette-hundm05))
;; Reine Gefaellestrecke ohne Stationen -> eine einzige GF.
(tu-eq "csv:kette-einheiten/nur-gf"
'(("GF" (1 2 3)))
(csv:kette-einheiten '("AS" "STRECKENELEMENT" "BOGEN" "SEP" "ES")))
;; Kette beginnt direkt mit dem Foerderer (Separator gleich hinter dem AS),
;; endet mit der Motorstation vor dem ES -> nur eine VF, keine leeren GF.
(tu-eq "csv:kette-einheiten/nur-vf"
'(("VF" (1 2 3 4)))
(csv:kette-einheiten '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES")))
;; Umlenkstation ohne Separator davor beginnt die VF selbst; der Separator,
;; der NICHT vor einer Umlenkstation steht, bleibt im Gefaelle.
(tu-eq "csv:kette-einheiten/umlenk-ohne-sep"
'(("GF" (1 2)) ("VF" (3 4 5)))
(csv:kette-einheiten '("AS" "SEP" "BOGEN" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES")))
;; --- csv:kette-sep-typen: Separator erbt den Typ seiner Einheit ---
;; HundM05 VF_5: Einlauf-Separator vor der Umlenkstation (2) -> VF; der
;; Separator hinter der Motorstation (11) -> GF; der Separator hinter dem
;; Gefaellestueck, der zugleich Einlauf der zweiten VF ist (13) -> VF; der
;; Separator vor dem ES (27) -> GF.
(tu-eq "csv:kette-sep-typen/hundm05"
'((2 . "VF") (11 . "GF") (13 . "VF") (27 . "GF"))
(csv:kette-sep-typen _kette-hundm05))
;; Separator INNERHALB der VF (vor der Motorstation) -> VF.
(tu-eq "csv:kette-sep-typen/sep-im-koerper"
'((1 . "VF") (4 . "VF") (7 . "GF"))
(csv:kette-sep-typen '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "SEP"
"STRECKENELEMENT" "MOTORSTATION" "SEP" "ES")))
;; Reine Gefaellestrecke -> alle GF; Kette ohne Separator -> nil.
(tu-eq "csv:kette-sep-typen/nur-gf"
'((1 . "GF") (3 . "GF"))
(csv:kette-sep-typen '("AS" "SEP" "STRECKENELEMENT" "SEP" "ES")))
(tu-nil "csv:kette-sep-typen/ohne-sep"
(csv:kette-sep-typen '("AS" "STRECKENELEMENT" "ES")))
;; --- csv:kette-ordnen: Vektorkette K2 -> K1, unabhaengig von der
;; Eingangsreihenfolge; Start am AS. rec wird dafuer nicht gebraucht (nil).
(setq _t-as (list "AS" nil '(0.0 0.0 0.0) '(10.0 0.0 0.0)))
(setq _t-s1 (list "STRECKENELEMENT" nil '(10.0 0.0 0.0) '(20.0 0.0 0.0)))
(setq _t-b (list "BOGEN" nil '(20.0 0.0 0.0) '(20.0 10.0 0.0)))
(setq _t-es (list "ES" nil '(20.0 10.0 0.0) '(30.0 10.0 0.0)))
(tu-eq "csv:kette-ordnen/verwuerfelt"
(list _t-as _t-s1 _t-b _t-es)
(csv:kette-ordnen (list _t-b _t-es _t-as _t-s1) "TEST"))
;; Innerhalb der Toleranz (2 mm) gilt ein Anschluss noch als geschlossen.
(setq _t-s1b (list "STRECKENELEMENT" nil '(11.5 0.0 0.0) '(20.0 0.0 0.0)))
(tu-eq "csv:kette-ordnen/toleranz"
(list _t-as _t-s1b)
(csv:kette-ordnen (list _t-s1b _t-as) "TEST"))
;; --- csv:export-modus-setzen / -p-Praedikate: 3 Modi + Ungueltig-Schutz --
;; Bestehenden Modus sichern/wiederherstellen, damit dieser Testblock keine
;; Seiteneffekte auf nachfolgende Tests oder eine laufende Sitzung hat.
;; --- Hilfskopien behalten: EIN Schalter (csv_leave_proxies), der Dialog
;; schaltet denselben Zustand. Alten Wert sichern/wiederherstellen.
(setq _hk-alt (csv:hilfskopien-behalten-p))
(csv:hilfskopien-behalten-setzen T)
(tu-true "csv:hilfskopien-behalten/an" (csv:hilfskopien-behalten-p))
(tu-true "csv:hilfskopien-behalten/an-ist-dbg-schalter" (dbg-schalter-p "csv_leave_proxies"))
(csv:hilfskopien-behalten-setzen nil)
(tu-nil "csv:hilfskopien-behalten/aus" (csv:hilfskopien-behalten-p))
(csv:hilfskopien-behalten-setzen _hk-alt)
(setq _modus-alt *csv-export-modus*)
(csv:export-modus-setzen "all_elements")
(tu-eq "csv:export-modus-setzen/all_elements" "all_elements" *csv-export-modus*)
(tu-true "csv:export-alle-elemente-p/all_elements" (csv:export-alle-elemente-p))
(tu-nil "csv:export-separator-track-p/all_elements" (csv:export-separator-track-p))
(csv:export-modus-setzen "group_vf_gf")
(tu-eq "csv:export-modus-setzen/group_vf_gf" "group_vf_gf" *csv-export-modus*)
(tu-nil "csv:export-alle-elemente-p/group_vf_gf" (csv:export-alle-elemente-p))
(tu-nil "csv:export-separator-track-p/group_vf_gf" (csv:export-separator-track-p))
(csv:export-modus-setzen "separator_track")
(tu-eq "csv:export-modus-setzen/separator_track" "separator_track" *csv-export-modus*)
(tu-nil "csv:export-alle-elemente-p/separator_track" (csv:export-alle-elemente-p))
(tu-true "csv:export-separator-track-p/separator_track" (csv:export-separator-track-p))
;; Ungueltiger Wert wird ignoriert - Modus bleibt auf dem zuletzt gueltig
;; gesetzten Stand (hier "separator_track").
(csv:export-modus-setzen "unbekannt")
(tu-eq "csv:export-modus-setzen/ungueltig-ignoriert" "separator_track" *csv-export-modus*)
(csv:export-modus-setzen _modus-alt)
;; --- Gefrorene Layer: Schalter + Hilfskopien-Ausschluss (file-frei) ---
;; Records (hilfsobjekt wrapper ...) mit Symbolen als Stand-ins fuer
;; Entities; das Praedikat ersetzt ssg-ent-layer-gefroren-p.
(setq _gef-alt (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen T)
(tu-true "csv:gefrorene-ausschliessen/an" (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen nil)
(tu-nil "csv:gefrorene-ausschliessen/aus" (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen _gef-alt)
(setq _gef-recs '((sep1 vf1 "SEP") (sep2 vf2 "SEP") (mark1 vf1 "AS") (unit1 gf1 "E" 1)))
(tu-eq "csv:hilfskopien-ausschluss/wrapper-vf1-gefroren" '(sep1 mark1)
(csv:hilfskopien-ausschluss _gef-recs (function (lambda (w) (eq w 'vf1)))))
(tu-eq "csv:hilfskopien-ausschluss/zwei-wrapper" '(sep2 unit1)
(csv:hilfskopien-ausschluss _gef-recs
(function (lambda (w) (member w '(vf2 gf1))))))
(tu-nil "csv:hilfskopien-ausschluss/nichts-gefroren"
(csv:hilfskopien-ausschluss _gef-recs (function (lambda (w) nil))))
(tu-nil "csv:hilfskopien-ausschluss/leere-liste"
(csv:hilfskopien-ausschluss nil (function (lambda (w) T))))
(tu-nil "csv:hilfskopien-ausschluss/record-ohne-wrapper"
(csv:hilfskopien-ausschluss '((sep1)) (function (lambda (w) T))))
)
;; ------------------------------------------------------------
;; TESTS: export.lsp - Hoehen-Attribute aus Z neu berechnen
;; ------------------------------------------------------------
(defun tu-tests-hoehen ( / _w)
(princ "\n[export/hoehen]")
;; Nicht verschoben -> nil (Block bleibt beim Bau-Wert)
(tu-nil "csv:hoehen-werte/kreisel-unveraendert"
(csv:hoehen-werte "KREISEL" 2000.0 '(("HOEHE" . "2000") ("MONTAGEHOEHE_m" . "1.800"))))
(tu-nil "csv:hoehen-werte/vf-unveraendert"
(csv:hoehen-werte "VF" 2000.0 '(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "1876"))))
;; Kreisel / Eckrad verschoben
(setq _w (csv:hoehen-werte "KREISEL" 2500.0 '(("HOEHE" . "2000"))))
(tu-eq "csv:hoehen-werte/kreisel-hoehe" "2500" (cdr (assoc "HOEHE" _w)))
(tu-eqf "csv:hoehen-werte/kreisel-montage" 2.5 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
(setq _w (csv:hoehen-werte "ECKRAD" 1500.0 '(("HOEHE" . "2000"))))
(tu-eq "csv:hoehen-werte/eckrad-hoehe" "1500" (cdr (assoc "HOEHE" _w)))
(tu-nil "csv:hoehen-werte/eckrad-ohne-montage" (assoc "MONTAGEHOEHE_m" _w))
;; GF abwaerts: Differenz 124 bleibt, MONTAGE = VON/1000
(setq _w (csv:hoehen-werte "GF" 2500.0
'(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "1876") ("DELTA_H_mm" . "123"))))
(tu-eq "csv:hoehen-werte/gf-von" "2500" (cdr (assoc "HOEHE_VON_mm" _w)))
(tu-eq "csv:hoehen-werte/gf-bis" "2376" (cdr (assoc "HOEHE_BIS_mm" _w)))
(tu-eqf "csv:hoehen-werte/gf-montage" 2.5 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
;; VF steigend ("Auf"): BIS liegt ueber VON, DELTA_H_mm ohne Vorzeichen
(setq _w (csv:hoehen-werte "VF" 1000.0
'(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "2400") ("DELTA_H_mm" . "400"))))
(tu-eq "csv:hoehen-werte/vf-auf-von" "1000" (cdr (assoc "HOEHE_VON_mm" _w)))
(tu-eq "csv:hoehen-werte/vf-auf-bis" "1400" (cdr (assoc "HOEHE_BIS_mm" _w)))
(tu-eqf "csv:hoehen-werte/vf-auf-montage" 1.2 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
;; VF ohne VON/BIS -> Rueckfall z - DELTA_H_mm
(setq _w (csv:hoehen-werte "VF" 3000.0 '(("DELTA_H_mm" . "500"))))
(tu-eq "csv:hoehen-werte/vf-rueckfall-bis" "2500" (cdr (assoc "HOEHE_BIS_mm" _w)))
)
;; ------------------------------------------------------------
;; 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)))))
;; Verbinder-Pfad: Backslashes normalisiert, abschliessender Trenner entfernt
(tu-eq "omni:verbinder-pfad/backslash"
"C:/x/data/omniflo/Verbinder/TV_W-W_kpl.dwg"
(omni:verbinder-pfad "C:\\x\\data" "TV_W-W_kpl"))
(tu-eq "omni:verbinder-pfad/trenner"
"C:/x/data/omniflo/Verbinder/VB_ENDP_AP.dwg"
(omni:verbinder-pfad "C:/x/data/" "VB_ENDP_AP"))
)
;; ------------------------------------------------------------
;; TESTS: KreiselInsert.lsp - Geometrie-Helfer
;; ------------------------------------------------------------
(defun tu-tests-kreisel ( / _e)
(princ "\n[KreiselInsert]")
;; Drehrichtungspfeil: AN8-Mitte 90 Grad, SP8-Mitte 270 Grad, GUZ gespiegelt
(tu-eqf "kreisel-pfeil-params/uzs"
'(((400.0 0.0 0.0) 90.0 1.0) ((2700.0 0.0 0.0) 270.0 1.0))
(kreisel-pfeil-params 400.0 2300.0 "UZS"))
(tu-eqf "kreisel-pfeil-params/guz"
'(((400.0 0.0 0.0) 90.0 -1.0) ((2700.0 0.0 0.0) 270.0 -1.0))
(kreisel-pfeil-params 400.0 2300.0 "GUZ"))
(tu-eqf "kreisel-pfeil-xskal/nil-ist-uzs" 1.0 (kreisel-pfeil-xskal nil))
(tu-eqf "eckrad-pfeil-params/guz"
'(((0.0 0.0 0.0) 90.0 -1.0)) (eckrad-pfeil-params "GUZ"))
;; KreiselInsert: Abstand + Rotation aus der Gummiband-Linie
(tu-eqf "kreisel-insert-richtung/ost"
'(2300.0 0.0) (kreisel-insert-richtung '(100.0 100.0 0.0) '(2400.0 100.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/sued"
'(1500.0 270.0) (kreisel-insert-richtung '(0.0 0.0 0.0) '(0.0 -1500.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/z-ignoriert"
'(1000.0 90.0) (kreisel-insert-richtung '(0.0 0.0 2000.0) '(0.0 1000.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/enter-vorgabe"
'(2300.0 0.0) (kreisel-insert-richtung '(0.0 0.0 0.0) nil 2300.0))
;; 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))
;; Beschriftung mit/ohne eigenen Namen
(tu-eq "kreisel-label-text/name"
"KREISEL 3: Puffer STANDARD_2300" (kreisel-label-text 3 "Puffer" "STANDARD" 2300.0))
(tu-eq "kreisel-label-text/vorgabe-name"
"KREISEL 3: PIN_4000" (kreisel-label-text 3 "Kreisel3" "PIN" 4000.0))
(tu-eq "kreisel-label-text/leer"
"KREISEL 3: PIN_4000" (kreisel-label-text 3 "" "PIN" 4000.0))
;; Eckrad-Dialog: Eingaben -> (attribs . rotation)
(setq _e (eckrad-dialog-werte '(("NUMMER" . "3") ("HOEHE" . "0") ("DREHRICHTUNG" . "UZS"))
"Eck3" "2500" "-90" "1" "0" "1"))
(tu-eqf "eckrad-dialog-werte/rotation-normiert" 270.0 (cdr _e))
(tu-eq "eckrad-dialog-werte/hoehe" "2500" (cdr (assoc "HOEHE" (car _e))))
(tu-eq "eckrad-dialog-werte/nummer-bleibt" "3" (cdr (assoc "NUMMER" (car _e))))
(tu-eq "eckrad-dialog-werte/name" "Eck3" (cdr (assoc "Bezeichnung" (car _e))))
(tu-eq "eckrad-dialog-werte/guz" "GUZ" (cdr (assoc "DREHRICHTUNG" (car _e))))
(tu-eq "eckrad-dialog-werte/einzelmodul" "0" (cdr (assoc "GERUEST_EINZELMODUL" (car _e))))
(tu-eq "eckrad-dialog-werte/geruest-typ" (nth 1 *ssg-geruest-optionen*)
(cdr (assoc "GERUEST_TYP" (car _e))))
(tu-nil "eckrad-dialog-werte/hoehe-ungueltig"
(eckrad-dialog-werte nil "" "abc" "0" "0" "1" "2"))
(tu-nil "eckrad-dialog-werte/drehung-leer"
(eckrad-dialog-werte nil "" "2000" "" "0" "1" "2"))
)
;; ------------------------------------------------------------
;; TESTS: KreiselInsert.lsp - Beruehrpunkte/Weichen (kreisel-bp-*)
;; ------------------------------------------------------------
;; Element-Record kurz: (typ x y z rot abstand id)
(defun tu-bp-el (typ x y z rot abstand id)
(kreisel-bp-element typ (list x y) z rot abstand 400.0 id id id)
)
(defun tu-bp-arten (treffer)
(mapcar '(lambda (tr) (cdr (assoc "art" tr))) treffer)
)
(defun tu-tests-kreisel-bp ( / _els _erg _ber _kol)
(princ "\n[KreiselInsert/Beruehrpunkte]")
;; Hilfs-Kerne
(tu-eqf "kreisel-bp-abstand/attribut" 7715.0 (kreisel-bp-abstand "7715" "KREISEL_1_STANDARD_7715"))
(tu-eqf "kreisel-bp-abstand/blockname" 3469.0 (kreisel-bp-abstand nil "KREISEL_3_STANDARD_3469"))
(tu-eqf "kreisel-bp-naechste-punkte/kreuz"
'((5.0 0.0) (5.0 0.0))
(kreisel-bp-naechste-punkte '(0.0 0.0) '(10.0 0.0) '(5.0 -5.0) '(5.0 5.0)))
;; Die 11 Einfuegungen aus tests/testdata/schnittspunkte_kreisel.dxf
(setq _els
(list
(tu-bp-el "ECKRAD" 22405.42028816571 -4021.762548616969 5000.0 270.0 0.0 "E1")
(tu-bp-el "KREISEL" 20971.14247926632 -3221.762548616969 5000.0 0.0 7715.0 "K1")
(tu-bp-el "KREISEL" 22503.49142858727 -2821.762548616969 5000.0 90.0 9020.0 "K2")
(tu-bp-el "KREISEL" 27253.08134883916 -3621.762548616969 5000.0 270.0 3469.0 "K3")
(tu-bp-el "KREISEL" 22503.49142858727 6998.075803812235 5000.0 90.0 4746.0 "K4")
(tu-bp-el "KREISEL" 22405.42028816571 -4421.762548616969 5000.0 270.0 6147.0 "K5")
(tu-bp-el "KREISEL" 26853.08134883916 -6582.442351476258 5000.0 180.0 3248.0 "K6")
(tu-bp-el "KREISEL" 32541.84792939903 -5752.219206460449 2000.0 270.0 9200.0 "K7")
(tu-bp-el "KREISEL" 32941.84792939903 -7662.266486416901 2000.0 0.0 3637.0 "K8a")
(tu-bp-el "KREISEL" 32941.84792939903 -11185.64734962363 2000.0 0.0 3637.0 "K8b")
(tu-bp-el "ECKRAD" 20571.14247926632 -3221.762548616969 5000.0 270.0 0.0 "E1b")))
(setq _erg (kreisel-bp-berechnen _els 1.0 1.0)
_ber (car _erg)
_kol (cadr _erg))
(tu-eq "kreisel-bp/dxf-beruehrungen" 10 (length _ber))
(tu-eq "kreisel-bp/dxf-kollisionen" 0 (length _kol))
(tu-eq "kreisel-bp/dxf-kreis-kreis" 3
(length (vl-remove-if-not '(lambda (a) (= a "Kreis/Kreis")) (tu-bp-arten _ber))))
(tu-eq "kreisel-bp/dxf-paare"
'(("E1" "K1") ("E1" "K5") ("K1" "K2") ("K1" "K3") ("K1" "E1b") ("K2" "K4")
("K3" "K6") ("K5" "K6") ("K7" "K8a") ("K7" "K8b"))
(mapcar '(lambda (tr) (list (cdr (assoc "id" (cdr (assoc "a" tr))))
(cdr (assoc "id" (cdr (assoc "b" tr))))))
_ber))
;; K2 (AN8) steht auf dem oberen Laufprofil von K1
(tu-eqf "kreisel-bp/dxf-punkt-k1-k2"
(list 22503.49142858727 -2821.762548616969)
(cdr (assoc "p" (nth 2 _ber))))
(tu-eq "kreisel-bp/dxf-achse-von-k1-k2" "K2" (cdr (assoc "achse_von" (nth 2 _ber))))
;; Unterschiedliche Hoehe -> kein Kontakt
(tu-eq "kreisel-bp/hoehe"
'(nil nil)
(kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 800.0 0.0 500.0 0.0 0.0 "B"))
1.0 1.0))
;; Zwei Eckraeder Rad an Rad -> eine Weiche in der Mitte
(setq _ber (car (kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 800.0 0.0 0.0 0.0 0.0 "B"))
1.0 1.0)))
(tu-eq "kreisel-bp/eckraeder-art" '("Kreis/Kreis") (tu-bp-arten _ber))
(tu-eqf "kreisel-bp/eckraeder-punkt" '(400.0 0.0) (cdr (assoc "p" (car _ber))))
;; Spalt groesser als Toleranz -> nichts
(tu-eq "kreisel-bp/spalt"
'(nil nil)
(kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 805.0 0.0 0.0 0.0 0.0 "B"))
1.0 1.0))
;; Laufprofile kreuzen sich -> Kollision, keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 1000.0 -1500.0 0.0 90.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/kreuzung-keine-weiche" (car _erg))
(tu-eq "kreisel-bp/kreuzung-kollision" '("Ueberschneidung") (tu-bp-arten (cadr _erg)))
;; Kreisel Seite an Seite (Profile aufeinander) -> Kollision, keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 500.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/parallel-keine-weiche" (car _erg))
(tu-eq "kreisel-bp/parallel-kollision" '("Tangente/Tangente") (tu-bp-arten (cadr _erg)))
;; Eckrad an der Flanke eines Kreiselrades -> Weiche (freie Seite)
(setq _ber (car (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "ECKRAD" 400.0 800.0 0.0 0.0 0.0 "B"))
1.0 1.0)))
(tu-eq "kreisel-bp/flanke-eckrad" 1 (length _ber))
;; Kreisel seitlich versetzt Ende an Ende (Raeder Flanke an Flanke, aber in
;; Gegenrichtung) -> Weiche, keine Seite-an-Seite-Kollision
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 2000.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-eq "kreisel-bp/ende-an-ende-art" '("Kreis/Kreis") (tu-bp-arten (car _erg)))
(tu-eqf "kreisel-bp/ende-an-ende-punkt" '(2400.0 400.0) (cdr (assoc "p" (car (car _erg)))))
(tu-nil "kreisel-bp/ende-an-ende-keine-kollision" (cadr _erg))
;; Gleich ausgerichtete Raeder Flanke an Flanke (echtes Seite an Seite) -> keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 0.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/seite-an-seite-keine-weiche" (car _erg))
;; results/test.dxf (E3/C7): Kreisel 2/3/4 Ende an Ende (0.9 mm Ueberlappung bzw.
;; 5.5 mm), Kreisel 8 vor dem Profil von Kreisel 9 (2.6 mm Spalt) - mit 10 mm
;; Toleranz drei Weichen
(setq _erg (kreisel-bp-berechnen
(list (tu-bp-el "KREISEL" 4940.03 -7603.25 2000.0 90.0 4500.0 "2")
(tu-bp-el "KREISEL" 5739.13 -12898.65 2000.0 90.0 5296.0 "3")
(tu-bp-el "KREISEL" 6533.6 -7603.44 2000.0 90.0 7889.0 "4")
(tu-bp-el "KREISEL" -61.76 -974.08 2000.0 90.0 4000.0 "9")
(tu-bp-el "KREISEL" 340.85 505.79 2000.0 0.0 3400.0 "8"))
10.0 1.0))
(tu-eq "kreisel-bp/test-dxf-paare"
'(("2" "3") ("3" "4") ("9" "8"))
(mapcar '(lambda (tr) (list (cdr (assoc "id" (cdr (assoc "a" tr))))
(cdr (assoc "id" (cdr (assoc "b" tr))))))
(car _erg)))
(tu-nil "kreisel-bp/test-dxf-keine-kollision" (cadr _erg))
)
;; ------------------------------------------------------------
;; 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. Die Traeger liegen in geruest_traeger.json.
(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" 4 (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.
;; Die Keys unter "attribute" sind die Block-Attribut-Tags und darum
;; GROSS geschrieben (ssg-json-get unterscheidet Gross/Klein).
(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-eq "json/geruest-farboptionen" '("RAL7035" "RAL7030")
(ssg-json-get (ssg-json-get (ssg-json-get _bg "attribute") "TEILEFARBE")
"optionen"))
)
)
)
(tu-record nil "json/geruest-datei" (strcat "nicht gefunden: " _datei))
)
)
;; ------------------------------------------------------------
;; TESTS: GeruestInsert.lsp - reine Hilfsfunktionen
;; ------------------------------------------------------------
;; Anzahl der Artikel (Blatt-Eintraege, Gruppen "teile" rekursiv) ohne
;; sivas_id oder ohne farbig-Schluessel. assoc statt ssg-json-get: false
;; wird zu nil geparst, der Schluessel selbst muss aber vorhanden sein.
(defun tu-geruest-artikel-unvollstaendig (eintraege / n teile)
(setq n 0)
(foreach e eintraege
(setq teile (ssg-json-get e "teile"))
(if teile
(setq n (+ n (tu-geruest-artikel-unvollstaendig teile)))
(if (or (null (ssg-json-get e "sivas_id"))
(null (assoc "farbig" e)))
(setq n (1+ n)))
)
)
n
)
(defun tu-tests-geruest ( / _eintrag _gruppe _teile _konfig _rec _pfad _f
_zurueck _bgtest _saeulen _vmq _alt _fs)
(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 stueckzahl 2 -> Artikelnummer zweimal (ARTINR-Regel)
(setq _eintrag (ssg-json-parse
"{\"artikel\": \"X\", \"sivas_id\": 825002019, \"stueckzahl\": 2}"))
(tu-eq "geruest-artnr/stueckzahl2" '("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, \"stueckzahl\": 1},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}")))
(tu-eq "geruest-artnr/gruppe" '("111" "222" "222")
(geruest-artikelnummern _gruppe))
(tu-eq "geruest-name/gruppe" "Schraubenset" (geruest-eintrag-name _gruppe))
;; Fehlendes stueckzahl-Feld -> 1
(tu-eq "geruest-artnr/ohne-stueckzahl" '("333")
(geruest-artikelnummern
(ssg-json-parse "{\"artikel\": \"C\", \"sivas_id\": 333}")))
;; --- Teile-DWGs (visuelle Rueckmeldung im Block) ---
(tu-eq "geruest-eindeutig/dupl" '("1" "2" "3")
(geruest-eindeutig '("1" "2" "1" "3" "2")))
(tu-eq "geruest-eindeutig/leer" nil (geruest-eindeutig nil))
;; Artikelnummer ohne DWG -> still uebergangen
(tu-eq "geruest-teile-dwgs/fehlt" nil
(geruest-teile-dwgs '("999999999")))
;; Vorhandene DWG (liegt im Repo) -> genau ein Pfad, auch bei Mehrfach-
;; Stueckzahl und gemischt mit einer fehlenden Nummer
(setq _pfad (geruest-dummy-pfad "825002019.dwg"))
(if (and _pfad (findfile _pfad))
(tu-eq "geruest-teile-dwgs/vorhanden" (list _pfad)
(geruest-teile-dwgs '("825002019" "999999999" "825002019")))
)
;; --- Anzahl-Vorgabe (Dialogfeld) vs. stueckzahl (wirklich geschrieben) ---
(tu-eq "geruest-anzahl-vorgabe/gruppe" 2
(geruest-anzahl-vorgabe (ssg-json-parse
"{\"name\": \"G\", \"anzahl_vorgabe\": 2, \"teile\": [{\"sivas_id\": 1, \"stueckzahl\": 1}]}")))
;; stueckzahl ist KEINE Vorgabe fuer das Dialogfeld
(tu-eq "geruest-anzahl-vorgabe/stueckzahl-zaehlt-nicht" 1
(geruest-anzahl-vorgabe (ssg-json-parse "{\"sivas_id\": 1, \"stueckzahl\": 3}")))
(tu-eq "geruest-anzahl-vorgabe/ohne" 1
(geruest-anzahl-vorgabe (ssg-json-parse "{\"name\": \"G\", \"teile\": []}")))
;; anzahl_vorgabe bestimmt nur die Vorbelegung, nicht den Satzinhalt:
;; 3 Saetze a (1 Schraube + 1 Duebel) = 6 Nummern
(tu-eq "geruest-artikelnummern-n/anzahl-vorgabe" '("1" "2" "1" "2" "1" "2")
(geruest-artikelnummern-n (ssg-json-parse
"{\"name\": \"G\", \"anzahl_vorgabe\": 2, \"teile\": [{\"sivas_id\": 1, \"stueckzahl\": 1}, {\"sivas_id\": 2, \"stueckzahl\": 1}]}")
3))
;; Einzelteil-Anbauteil: Anzahl x stueckzahl
(tu-eq "geruest-artikelnummern-n/einzelteil-stueckzahl" '("7" "7" "7" "7")
(geruest-artikelnummern-n (ssg-json-parse
"{\"artikel\": \"X\", \"sivas_id\": 7, \"stueckzahl\": 2, \"anzahl_vorgabe\": 5}")
2))
;; Dummy, der zugleich Teile-DWG ist, faellt aus der Teileliste
(tu-eq "geruest-ohne-pfad/entfernt" '(("b/2.dwg" . 90.0))
(geruest-ohne-pfad "A/1.DWG" '(("a/1.dwg" . 0.0) ("b/2.dwg" . 90.0))))
(tu-eq "geruest-ohne-pfad/nil" '(("a/1.dwg" . 0.0))
(geruest-ohne-pfad nil '(("a/1.dwg" . 0.0))))
;; Dummy-Wahl: Variante gewinnt, fehlende Varianten-DWG -> Baugruppe
(setq _pfad (geruest-dummy-pfad "821006036.dwg"))
(if (and _pfad (findfile _pfad))
(tu-eq "geruest-dummy-wahl/variante" "821006036.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"dummy\": \"821006036.dwg\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
)
(tu-eq "geruest-dummy-wahl/fehlt" "basis.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"dummy\": \"gibtsnicht_999.dwg\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
(tu-eq "geruest-dummy-wahl/ohne" "basis.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"name\": \"X\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
;; --- 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-anzahl-wert/leer" 2 (geruest-anzahl-wert "" 2))
(tu-eq "geruest-anzahl-wert/zahl" 5 (geruest-anzahl-wert "5" 2))
(tu-eq "geruest-anzahl-wert/null" nil (geruest-anzahl-wert "0" 2))
(tu-eq "geruest-anzahl-wert/text" nil (geruest-anzahl-wert "abc" 2))
(tu-eq "geruest-anzahl-wert/negativ" nil (geruest-anzahl-wert "-3" 2))
;; --- Einzelteil: Anzahl (Dialog) x stueckzahl (JSON, hier 2) ---
(tu-eq "geruest-artnr-n/einzelteil" 6
(length (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))
;; --- farbig-Flag / TEILEFARBE-Liste parallel zu ARTINR ---
;; _eintrag hat kein "farbig" -> nicht farbig
(tu-eq "geruest-paare/ohne-flag" '(("825002019") ("825002019"))
(geruest-teile-paare _eintrag nil))
(tu-eq "geruest-paare/farbig" '(("444" . T))
(geruest-teile-paare
(ssg-json-parse "{\"artikel\": \"D\", \"sivas_id\": 444, \"farbig\": true}")
nil))
(tu-eq "geruest-paare/false" '(("555"))
(geruest-teile-paare
(ssg-json-parse "{\"artikel\": \"E\", \"sivas_id\": 555, \"farbig\": false}")
nil))
;; Gruppe mit farbig vererbt an alle Teile, Mengen bleiben erhalten
(setq _teile (ssg-json-parse
(strcat "{\"name\": \"Set\", \"farbig\": true, \"teile\": ["
"{\"artikel\": \"A\", \"sivas_id\": 111},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}")))
(tu-eq "geruest-paare/gruppe-erbt" '(("111" . T) ("222" . T) ("222" . T))
(geruest-teile-paare _teile nil))
(tu-eq "geruest-paare-n/gruppe" 6 (length (geruest-teile-paare-n _teile 2)))
(tu-eq "geruest-paare-n/einzelteil-farbig" '(("444" . T) ("444" . T))
(geruest-teile-paare-n
(ssg-json-parse "{\"artikel\": \"D\", \"sivas_id\": 444, \"farbig\": true}")
2))
(tu-eq "geruest-farbliste" '("" "RAL7030" "")
(geruest-farbliste '(("1") ("2" . T) ("3")) "RAL7030"))
(tu-eq "geruest-farbliste/join" ",RAL7030,"
(ssg-join (geruest-farbliste '(("1") ("2" . T) ("3")) "RAL7030") ","))
;; --- 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\", \"anzahl\": 3},"
"{\"artikel\": \"unbekannt\", \"anzahl\": 1}]}")))
(tu-eq "geruest-konfig-position" '(nil 3)
(geruest-konfig-position _konfig "oben" _teile nil))
;; --- anbaugruppen: befestigung / sonstiges ---
(setq _bgtest (ssg-json-parse
(strcat "{\"anbaugruppen\": {\"befestigung\": [{\"artikel\": \"K\"}],"
" \"sonstiges\": [{\"artikel\": \"H1\"}, {\"artikel\": \"H2\"}]}}")))
(tu-eq "geruest-anbau-liste/befestigung" 1
(length (geruest-anbau-liste _bgtest "befestigung")))
(tu-eq "geruest-anbau-liste/sonstiges" '("H1" "H2")
(mapcar 'geruest-eintrag-name (geruest-anbau-liste _bgtest "sonstiges")))
;; altes flaches Array gilt als befestigung
(setq _rec (ssg-json-parse "{\"anbaugruppen\": [{\"artikel\": \"A\"}, {\"artikel\": \"B\"}]}"))
(tu-eq "geruest-anbau-liste/flach" 2 (length (geruest-anbau-liste _rec "befestigung")))
(tu-nil "geruest-anbau-liste/flach-sonstiges" (geruest-anbau-liste _rec "sonstiges"))
(tu-nil "geruest-anbau-liste/leer"
(geruest-anbau-liste
(ssg-json-parse "{\"anbaugruppen\": {\"befestigung\": [], \"sonstiges\": []}}")
"sonstiges"))
(tu-nil "geruest-anbau-liste/fehlt"
(geruest-anbau-liste (ssg-json-parse "{\"id\": \"X\"}") "befestigung"))
(tu-eq "geruest-dlg-standard/teile" '(("0" . "1") ("0" . "1"))
(geruest-dlg-standard (geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-mengen-addieren" '(nil 3 2 5)
(geruest-mengen-addieren '(nil 1 nil 2) '(nil 2 2 3)))
;; Alte Konfiguration mit Haltearm unter "oben": landet in sonstiges
;; (Mengen addiert), oben meldet ihn nicht als unbekannt
(setq _konfig (ssg-json-parse
(strcat "{\"name\": \"Alt\","
" \"oben\": [{\"artikel\": \"K\", \"anzahl\": 2}, {\"artikel\": \"H2\", \"anzahl\": 1}],"
" \"unten\": [{\"artikel\": \"H2\", \"anzahl\": 2}],"
" \"sonstiges\": [{\"artikel\": \"H1\", \"anzahl\": 4}]}")))
(tu-eq "geruest-konfig-position/ausweich" '(2)
(geruest-konfig-position _konfig "oben"
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
;; --- Winkel Platte: Basis ungedreht, Anbauteile gedreht, kein Doppel ---
(tu-eq "geruest-teile-dwgs-rot/90" '(("b.dwg" . 0.0) ("a.dwg" . 90.0))
(geruest-teile-dwgs-rot '("b.dwg") '("b.dwg" "a.dwg") 90))
(tu-eq "geruest-teile-dwgs-rot/0" '(("a.dwg" . 0.0))
(geruest-teile-dwgs-rot nil '("a.dwg") 0))
(tu-eq "geruest-rest-liste" '(3 4) (geruest-rest-liste '(1 2 3 4) 2))
(tu-eq "geruest-winkel-aus-index/90" 90 (geruest-winkel-aus-index "1"))
(tu-eq "geruest-winkel-aus-index/leer" 0 (geruest-winkel-aus-index ""))
(tu-eq "geruest-winkel-index/90" "1" (geruest-winkel-index 90))
(tu-eq "geruest-winkel-index/fehlt" "0" (geruest-winkel-index nil))
;; --- Radiobuttons der Varianten: Key "v<i>" <-> Index ---
(tu-eq "geruest-radio-key" "v3" (geruest-radio-key 3))
(tu-eq "geruest-radio-index" 3 (geruest-radio-index "v3"))
(tu-eq "geruest-radio-index/leer" 0 (geruest-radio-index ""))
(tu-eq "geruest-radio-index/nil" 0 (geruest-radio-index nil))
(tu-eq "geruest-indizes" '(0 1 2) (geruest-indizes 3))
(tu-nil "geruest-indizes/0" (geruest-indizes 0))
(tu-eq "geruest-dcl-varianten-zeilen"
'(" : radio_button { key = \"v1\"; label = \"B 1''\"; }")
(geruest-dcl-varianten-zeilen
(list '(("name" . "A")) '(("name" . "B 1\""))) '(1)))
;; Variante mit Teilen: Artikelnummern in Klammern, jede nur einmal
(tu-eq "geruest-varianten-label/nummern" "R 2\" (111, 222)"
(geruest-varianten-label
(ssg-json-parse
(strcat "{\"name\": \"R 2\\\"\", \"teile\": ["
"{\"artikel\": \"A\", \"sivas_id\": 111},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}"))))
(tu-eq "geruest-varianten-label/ohne" "A"
(geruest-varianten-label '(("name" . "A"))))
;; --- Gesperrte Varianten ("disabled": true) ---
(setq _rec (list '(("name" . "A") ("disabled" . T))
'(("name" . "B"))
'(("name" . "C") ("disabled" . T))))
(tu-true "geruest-variante-gesperrt-p/ja" (geruest-variante-gesperrt-p (nth 0 _rec)))
(tu-nil "geruest-variante-gesperrt-p/nein" (geruest-variante-gesperrt-p (nth 1 _rec)))
(tu-eq "geruest-erste-freie-variante" 1 (geruest-erste-freie-variante _rec))
(tu-eq "geruest-erste-freie-variante/alle-gesperrt" 0
(geruest-erste-freie-variante (list '(("disabled" . T)))))
(tu-eq "geruest-variante-waehlbar/frei" 1 (geruest-variante-waehlbar _rec 1))
(tu-eq "geruest-variante-waehlbar/gesperrt" 1 (geruest-variante-waehlbar _rec 2))
(tu-eq "geruest-variante-waehlbar/zu-gross" 1 (geruest-variante-waehlbar _rec 7))
;; Ersetzungen: ohne Teile entfallen die Bloecke (leerer Cluster)
(setq _rec (geruest-dcl-ersetzungen "Saeulen" nil nil
(list '(("name" . "A")))))
(tu-nil "geruest-dcl-ersetzungen/ohne-befestigung"
(cdr (assoc "BEFESTIGUNG" _rec)))
(tu-nil "geruest-dcl-ersetzungen/ohne-sonstiges"
(cdr (assoc "SONSTIGES" _rec)))
(tu-eq "geruest-dcl-ersetzungen/varianten" 1
(length (cdr (assoc "VARIANTEN" _rec))))
;; --- Geaenderte Konfiguration: Vergleich ohne Namen ---
(tu-true "geruest-record-gleich-p/name"
(geruest-record-gleich-p '(("name" . "A") ("laenge" . "100"))
'(("name" . "B") ("laenge" . "100"))))
(tu-nil "geruest-record-gleich-p/geaendert"
(geruest-record-gleich-p '(("name" . "A") ("laenge" . "100"))
'(("name" . "A") ("laenge" . "200"))))
;; Eigene Konfiguration gewinnt vor gleichnamiger Bibliothek; nur eine
;; eigene liefert eine Namensvorgabe (Ueberspeichern)
(setq _alt *geruest-konfig-liste*)
(setq *geruest-konfig-liste*
(list (cons nil '(("name" . "K"))) (cons T '(("name" . "K")))
(cons nil '(("name" . "L")))))
(tu-eq "geruest-konfig-index/eigene-zuerst" 2 (geruest-konfig-index "K"))
(tu-eq "geruest-konfig-index/bibliothek" 3 (geruest-konfig-index "L"))
(tu-eq "geruest-konfig-name-vorgabe/eigene" "K" (geruest-konfig-name-vorgabe 2))
(tu-nil "geruest-konfig-name-vorgabe/bibliothek" (geruest-konfig-name-vorgabe 1))
(tu-nil "geruest-konfig-name-vorgabe/keine" (geruest-konfig-name-vorgabe 0))
(setq *geruest-konfig-liste* _alt)
(tu-eq "geruest-konfig-sonstiges/umhaengen" '(4 3)
(geruest-konfig-sonstiges _konfig
(geruest-anbau-liste _bgtest "sonstiges")
(geruest-anbau-liste _bgtest "befestigung")))
;; Befestigung = Gesamtanzahl: neues Feld "befestigung", altes oben +
;; unten summiert; der Haltearm unter "oben" wird hier still uebergangen
(tu-eq "geruest-konfig-befestigung/alt" '(2)
(geruest-konfig-befestigung _konfig
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-konfig-befestigung/oben-unten" '(5)
(geruest-konfig-befestigung
(ssg-json-parse
(strcat "{\"name\": \"A\", \"oben\": [{\"artikel\": \"K\", \"anzahl\": 2}],"
" \"unten\": [{\"artikel\": \"K\", \"anzahl\": 3}]}"))
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-konfig-befestigung/neu" '(4)
(geruest-konfig-befestigung
(ssg-json-parse
"{\"name\": \"N\", \"befestigung\": [{\"artikel\": \"K\", \"anzahl\": 4}]}")
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
;; Artikelnummer(n) fuer die Anzeige: Einzelteil bzw. Gruppe eindeutig
(tu-eq "geruest-artnr-anzeige/einzelteil" "825002019"
(geruest-artnr-anzeige _eintrag))
(tu-eq "geruest-artnr-anzeige/gruppe" "111, 222"
(geruest-artnr-anzeige _gruppe))
;; Eine Befestigungsspalte (Prefix b) mit Art.-Nr.-Zeile je Teil
(setq _rec (geruest-dcl-ersetzungen "Saeulen" (list _eintrag) nil
(list '(("name" . "A")))))
(tu-true "geruest-dcl-ersetzungen/befestigung-key"
(vl-some '(lambda (z) (vl-string-search "key = \"bm0\"" z))
(cdr (assoc "BEFESTIGUNG" _rec))))
(tu-true "geruest-dcl-ersetzungen/artnr-zeile"
(vl-some '(lambda (z) (vl-string-search "Art.-Nr. 825002019" z))
(cdr (assoc "BEFESTIGUNG" _rec))))
;; --- 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 (geruest-baugruppe "Saeulen" (geruest-daten)))
(tu-eq "geruest/saeulen-vorhanden" T (if _saeulen T nil))
(if _saeulen
(progn
;; Aufbau statt fester Anzahl - geruest.json wird noch gepflegt.
;; Jeder Artikel braucht sivas_id und ein (auch false) farbig-Feld.
(tu-eq "geruest/saeulen-varianten" T
(if (ssg-json-get _saeulen "geometrie_varianten") T nil))
(tu-eq "geruest/saeulen-varianten-artikel" 0
(tu-geruest-artikel-unvollstaendig
(ssg-json-get _saeulen "geometrie_varianten")))
(tu-eq "geruest/saeulen-anbauteile" T
(if (geruest-anbau-liste _saeulen "befestigung") T nil))
(tu-eq "geruest/saeulen-anbauteile-artikel" 0
(tu-geruest-artikel-unvollstaendig
(geruest-anbau-liste _saeulen "befestigung")))
;; Haltearme passen weder oben noch unten -> eigene Sonstiges-Zeile
(tu-eq "geruest/saeulen-sonstiges" 4
(length (geruest-anbau-liste _saeulen "sonstiges")))
(tu-eq "geruest/saeulen-sonstiges-artikel" 0
(tu-geruest-artikel-unvollstaendig
(geruest-anbau-liste _saeulen "sonstiges")))
(tu-nil "geruest/saeulen-haltearm-nicht-befestigung"
(vl-some '(lambda (a)
(wcmatch (geruest-eintrag-name a) "HALTEARM*"))
(geruest-anbau-liste _saeulen "befestigung")))
;; Rohrabhaenger/Wandbefestigung haben keine Sonstiges-Teile
(foreach _e '("Rohrabhaenger" "Wandbefestigung")
(setq _rec (geruest-baugruppe _e (geruest-daten)))
(tu-true (strcat "geruest/" _e "-befestigung")
(geruest-anbau-liste _rec "befestigung"))
(tu-nil (strcat "geruest/" _e "-ohne-sonstiges")
(geruest-anbau-liste _rec "sonstiges")))
(tu-eq "geruest/saeulen-titel" "Saeulen" (geruest-titel _saeulen))
;; Variante R 1" traegt die eigene TEILEART - per Name gesucht,
;; die Reihenfolge in geruest.json ist nicht fest.
(setq _rec (geruest-name-index "R 1\""
(ssg-json-get _saeulen "geometrie_varianten")))
(tu-eq "geruest/saeulen-1zoll-vorhanden" T (if _rec T nil))
(if _rec
(tu-eq "geruest/saeulen-1zoll-teileart" "Geruest Saeule 1 Zoll"
(geruest-variante-wert
(nth _rec (ssg-json-get _saeulen "geometrie_varianten"))
_saeulen "teileart")))
;; Attribut-Keys GROSS - sonst findet geruest-dialog min/max und
;; Farben nicht (Laengenfeld ohne Pruefung, leere Farbliste).
(tu-eq "geruest/saeulen-laenge-max" 6000
(geruest-attr-feld nil _saeulen "LAENGE" "max"))
(tu-true "geruest/saeulen-farboptionen"
(geruest-attr-feld nil _saeulen "TEILEFARBE" "optionen"))
)
)
;; --- Rohr-Geruest-Traeger: reine Berechnung ---
;; Netto-Laenge = Strecke minus beide Abzuege, nil wenn nichts uebrig
(tu-eqf "geruest-traeger-laenge/ende" 965.0 (geruest-traeger-laenge 1000.0 0.0 35.0))
(tu-eqf "geruest-traeger-laenge/beide" 945.0 (geruest-traeger-laenge 1000.0 20.0 35.0))
(tu-eqf "geruest-traeger-laenge/ohne" 1000.0 (geruest-traeger-laenge 1000.0 nil nil))
(tu-nil "geruest-traeger-laenge/zu-kurz" (geruest-traeger-laenge 50.0 30.0 30.0))
(tu-nil "geruest-traeger-laenge/genau-null" (geruest-traeger-laenge 60.0 30.0 30.0))
;; Startpunkt wird um den Anfangsabzug entlang der Richtung eingerueckt,
;; Z bleibt die des Startklicks
(tu-eqf "geruest-traeger-start/0grad" '(20.0 0.0 500.0)
(geruest-traeger-start '(0.0 0.0 500.0) 0.0 20.0))
(tu-eqf "geruest-traeger-start/90grad" '(100.0 220.0 0.0)
(geruest-traeger-start '(100.0 200.0 0.0) (/ pi 2.0) 20.0))
(tu-eqf "geruest-traeger-start/2d-punkt" '(5.0 0.0 0.0)
(geruest-traeger-start '(5.0 0.0) 0.0 0.0))
;; Querstreben: Abstand IMMER genau 500, beide Raender gleich; gewaehlt
;; wird die Strebenzahl mit dem Rand am naechsten an 100..250
;; (Gleichstand -> weniger Streben). Plan = (rand positionen).
;; Im Bereich:
(tu-eqf "geruest-traeger-plan/1000" '(250.0 (250.0 750.0))
(geruest-traeger-streben-plan 1000.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1200" '(100.0 (100.0 600.0 1100.0))
(geruest-traeger-streben-plan 1200.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1300" '(150.0 (150.0 650.0 1150.0))
(geruest-traeger-streben-plan 1300.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1500" '(250.0 (250.0 750.0 1250.0))
(geruest-traeger-streben-plan 1500.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/400" '(200.0 (200.0))
(geruest-traeger-streben-plan 400.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/500" '(250.0 (250.0))
(geruest-traeger-streben-plan 500.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/200" '(100.0 (100.0))
(geruest-traeger-streben-plan 200.0 500.0 100.0 250.0))
;; Ausserhalb (netto mod 500 in (0, 200) oder netto < 200) - der Plan
;; kommt trotzdem, der Abstand bleibt 500:
;; 1100: Rand 300 (k=1) oder 50 (k=2), beide 50 daneben -> weniger Streben
(tu-eqf "geruest-traeger-plan/1100" '(300.0 (300.0 800.0))
(geruest-traeger-streben-plan 1100.0 500.0 100.0 250.0))
;; 1050: Rand 275 (25 daneben) schlaegt 25 (75 daneben)
(tu-eqf "geruest-traeger-plan/1050" '(275.0 (275.0 775.0))
(geruest-traeger-streben-plan 1050.0 500.0 100.0 250.0))
;; 1150: Rand 75 (25 daneben) schlaegt 325 (75 daneben)
(tu-eqf "geruest-traeger-plan/1150" '(75.0 (75.0 575.0 1075.0))
(geruest-traeger-streben-plan 1150.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/501" '(250.5 (250.5))
(geruest-traeger-streben-plan 501.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/kurz-150" '(75.0 (75.0))
(geruest-traeger-streben-plan 150.0 500.0 100.0 250.0))
(tu-nil "geruest-traeger-plan/null"
(geruest-traeger-streben-plan 0.0 500.0 100.0 250.0))
;; Abstand zwischen zwei Streben ist in jedem Fall exakt 500
(foreach _l '(700.0 1100.0 1150.0 2345.0 5999.0)
(setq _rec (geruest-traeger-streben _l 500.0 100.0 250.0))
(tu-true (strcat "geruest-traeger-streben/abstand-" (rtos _l 2 0))
(vl-every '(lambda (a b) (equal (- b a) 500.0 1e-6))
_rec (cdr _rec))))
;; Rand-Abweichung
(tu-eqf "geruest-rand-abweichung/innen" 0.0 (geruest-rand-abweichung 150.0 100.0 250.0))
(tu-eqf "geruest-rand-abweichung/unten" 25.0 (geruest-rand-abweichung 75.0 100.0 250.0))
(tu-eqf "geruest-rand-abweichung/oben" 50.0 (geruest-rand-abweichung 300.0 100.0 250.0))
;; 6000 mm: 11 Felder a 500 -> 12 Streben, letzte bei 5750
(setq _rec (geruest-traeger-streben 6000.0 500.0 100.0 250.0))
(tu-eq "geruest-traeger-streben/6000-anzahl" 12 (length _rec))
(tu-eqf "geruest-traeger-streben/6000-letzte" 5750.0 (last _rec))
;; Konfiguration: fehlende Felder -> Standard, ohne querstrebe -> nil
;; Ergebnis (dummy laenge querlinie abstand rand-min rand-max)
;; Streben nur bei Varianten mit "mit_querstrebe": true
(setq _vmq (ssg-json-parse "{\"name\": \"A\", \"mit_querstrebe\": true}"))
(tu-eqf "geruest-traeger-strebe-cfg/standard" '(nil 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"rand_min\": 100}}")))
(tu-eqf "geruest-traeger-strebe-cfg/dummy" '("s.dwg" 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"dummy\": \"s.dwg\"}}")))
(tu-eqf "geruest-traeger-strebe-cfg/wert" '(nil 30.0 25.0 400.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-eqf "geruest-traeger-strebe-cfg/variante" '(nil 30.0 25.0 300.0 100.0 250.0)
(geruest-traeger-strebe-cfg
(ssg-json-parse
"{\"mit_querstrebe\": true, \"querstrebe\": {\"abstand\": 300}}")
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-nil "geruest-traeger-strebe-cfg/ohne-flag"
(geruest-traeger-strebe-cfg (ssg-json-parse "{\"name\": \"Rohr 1\"}")
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-nil "geruest-traeger-strebe-cfg/ohne-variante"
(geruest-traeger-strebe-cfg nil
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
;; Querlinien an Anfang und Ende der 30 mm langen Strebe
(tu-eqf "geruest-traeger-strebe-enden" '(235.0 265.0)
(geruest-traeger-strebe-enden 250.0 30.0))
(tu-nil "geruest-traeger-strebe-cfg/ohne"
(geruest-traeger-strebe-cfg _vmq (ssg-json-parse "{\"id\": \"X\"}")))
;; Muffe nur bei "mit_muffe": true; Variante darf eigene Muffe mitbringen
(setq _bgtest (ssg-json-parse "{\"muffe\": {\"dummy\": \"m.dwg\"}}"))
(tu-eq "geruest-traeger-muffe-dummy/flag" "m.dwg"
(geruest-traeger-muffe-dummy
(ssg-json-parse "{\"name\": \"A\", \"mit_muffe\": true}") _bgtest))
(tu-nil "geruest-traeger-muffe-dummy/ohne-flag"
(geruest-traeger-muffe-dummy
(ssg-json-parse "{\"name\": \"Rohr mit Muffe\"}") _bgtest))
(tu-eq "geruest-traeger-muffe-dummy/variante" "m2.dwg"
(geruest-traeger-muffe-dummy
(ssg-json-parse
"{\"mit_muffe\": true, \"muffe\": {\"dummy\": \"m2.dwg\"}}")
_bgtest))
(tu-nil "geruest-traeger-muffe-dummy/ohne-variante"
(geruest-traeger-muffe-dummy nil _bgtest))
;; --- Traeger-Beschriftung: reine Berechnung ---
;; Textwinkel entlang des Traegers, DIN: 90 < w <= 270 wird gedreht
(tu-eqf "geruest-text-winkel/0" 0.0 (geruest-text-winkel 0.0))
(tu-eqf "geruest-text-winkel/45" (/ pi 4.0) (geruest-text-winkel (/ pi 4.0)))
(tu-eqf "geruest-text-winkel/90" (/ pi 2.0) (geruest-text-winkel (/ pi 2.0)))
(tu-eqf "geruest-text-winkel/91" (* 271 (/ pi 180.0))
(geruest-text-winkel (* 91 (/ pi 180.0))))
(tu-eqf "geruest-text-winkel/180" 0.0 (geruest-text-winkel pi))
(tu-eqf "geruest-text-winkel/270" (/ pi 2.0) (geruest-text-winkel (* 1.5 pi)))
(tu-eqf "geruest-text-winkel/271" (* 271 (/ pi 180.0))
(geruest-text-winkel (* 271 (/ pi 180.0))))
;; -90 = 270 -> gedreht auf 90 (von unten nach oben lesbar)
(tu-eqf "geruest-text-winkel/-90" (/ pi 2.0) (geruest-text-winkel (- (/ pi 2.0))))
;; Ausrichtungs-Codes wie TEXT "Ausrichten" -> (dxf72 dxf73)
(tu-eq "geruest-ausrichtung/TL" '(0 3) (geruest-ausrichtung-codes "TL"))
(tu-eq "geruest-ausrichtung/TC" '(1 3) (geruest-ausrichtung-codes "TC"))
(tu-eq "geruest-ausrichtung/TR" '(2 3) (geruest-ausrichtung-codes "TR"))
(tu-eq "geruest-ausrichtung/ML" '(0 2) (geruest-ausrichtung-codes "ML"))
(tu-eq "geruest-ausrichtung/MC" '(1 2) (geruest-ausrichtung-codes "MC"))
(tu-eq "geruest-ausrichtung/MR" '(2 2) (geruest-ausrichtung-codes "MR"))
(tu-eq "geruest-ausrichtung/BL" '(0 1) (geruest-ausrichtung-codes "BL"))
(tu-eq "geruest-ausrichtung/BC" '(1 1) (geruest-ausrichtung-codes "BC"))
(tu-eq "geruest-ausrichtung/BR" '(2 1) (geruest-ausrichtung-codes "BR"))
(tu-eq "geruest-ausrichtung/klein" '(1 1) (geruest-ausrichtung-codes "bc"))
(tu-nil "geruest-ausrichtung/unbekannt" (geruest-ausrichtung-codes "XY"))
(tu-nil "geruest-ausrichtung/nil" (geruest-ausrichtung-codes nil))
;; Textlage: Bezugspunkt auf der Linie, "links" in Leserichtung
(tu-eqf "geruest-text-lage/0-BC" '((1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BC"))
(tu-eqf "geruest-text-lage/0-BL" '((0.0 0.0 0.0) 0.0 0 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BL"))
(tu-eqf "geruest-text-lage/0-BR" '((2000.0 0.0 0.0) 0.0 2 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BR"))
;; Traeger nach links (180): Text gedreht auf 0, links = Linienende
(tu-eqf "geruest-text-lage/180-BL" '((-2000.0 0.0 0.0) 0.0 0 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BL"))
(tu-eqf "geruest-text-lage/180-BR" '((0.0 0.0 0.0) 0.0 2 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BR"))
(tu-eqf "geruest-text-lage/180-BC" '((-1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BC"))
;; Unbekannter Code -> BC
(tu-eqf "geruest-text-lage/ersatz" '((1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "XY"))
;; Text: %1 = Variantentext, %2 = Laenge auf ganze mm
(tu-eq "geruest-text-string/beispiel" "RT 80/80 L=2650"
(geruest-traeger-text-string "%1 L=%2" "RT 80/80" 2649.5))
(tu-eq "geruest-text-string/abrunden" "L=965 RT"
(geruest-traeger-text-string "L=%2 %1" "RT" 965.4))
(tu-eq "geruest-text-string/mehrfach" "A A 10"
(geruest-traeger-text-string "%1 %1 %2" "A" 10.0))
;; Konfiguration je Feld: Variante vor Baugruppe vor Code-Standard
(setq _bgtest (ssg-json-parse
(strcat "{\"beschriftung\": {\"format\": \"%1 L=%2\", \"stil\": \"S1\","
" \"ausrichtung\": \"BC\", \"hoehe\": 50, \"layer\": \"D-5-BEM\"}}")))
(setq _rec (geruest-traeger-beschr-cfg
(ssg-json-parse
"{\"name\": \"RT 80/80 1 Zoll\", \"beschriftung\": {\"text\": \"RT 80/80\", \"layer\": \"D-6-BEM\"}}")
_bgtest "ERSATZ"))
(tu-eq "geruest-beschr-cfg/text" "RT 80/80" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/layer" "D-6-BEM" (cdr (assoc "layer" _rec)))
(tu-eq "geruest-beschr-cfg/stil" "S1" (cdr (assoc "stil" _rec)))
(tu-eqf "geruest-beschr-cfg/hoehe" 50.0 (cdr (assoc "hoehe" _rec)))
(setq _rec (geruest-traeger-beschr-cfg
(ssg-json-parse "{\"name\": \"Ohne Text\"}") _bgtest "ERSATZ"))
(tu-eq "geruest-beschr-cfg/text-name" "Ohne Text" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/layer-bg" "D-5-BEM" (cdr (assoc "layer" _rec)))
(setq _rec (geruest-traeger-beschr-cfg nil (ssg-json-parse "{\"id\": \"X\"}") "ERSATZ"))
(tu-eq "geruest-beschr-cfg/ersatz" "ERSATZ" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/std-format" "%1 L=%2" (cdr (assoc "format" _rec)))
(tu-eq "geruest-beschr-cfg/std-ausr" "BC" (cdr (assoc "ausrichtung" _rec)))
(tu-eqf "geruest-beschr-cfg/std-hoehe" 50.0 (cdr (assoc "hoehe" _rec)))
(tu-nil "geruest-beschr-cfg/std-layer" (cdr (assoc "layer" _rec)))
;; Bereichspruefung auf der Netto-Laenge
(tu-true "geruest-traeger-pruefen/innen" (geruest-traeger-pruefen 965.0 0 6000))
(tu-nil "geruest-traeger-pruefen/ueber" (geruest-traeger-pruefen 6001.0 0 6000))
(tu-true "geruest-traeger-pruefen/grenze" (geruest-traeger-pruefen 6000.0 0 6000))
(tu-true "geruest-traeger-pruefen/ohne" (geruest-traeger-pruefen 99999.0 nil nil))
(tu-nil "geruest-traeger-pruefen/nil" (geruest-traeger-pruefen nil 0 6000))
;; Eingaben in mm: Komma wie Punkt, negativ/Text ungueltig
(tu-eqf "geruest-mm-zahl/ganz" 35.0 (geruest-mm-zahl "35"))
(tu-eqf "geruest-mm-zahl/komma" 17.5 (geruest-mm-zahl "17,5"))
(tu-nil "geruest-mm-zahl/text" (geruest-mm-zahl "abc"))
(tu-nil "geruest-mm-zahl/negativ" (geruest-mm-zahl "-5"))
(tu-nil "geruest-mm-zahl/leer" (geruest-mm-zahl ""))
(tu-eqf "geruest-abzug-wert/leer" 0.0 (geruest-abzug-wert ""))
(tu-nil "geruest-abzug-wert/text" (geruest-abzug-wert "x"))
(tu-eqf "geruest-tr-abzug/inaktiv" 0.0 (geruest-tr-abzug "0" "x"))
(tu-eqf "geruest-tr-abzug/aktiv" 35.0 (geruest-tr-abzug "1" "35"))
(tu-eq "geruest-mm-string/ganz" "965" (geruest-mm-string 965.0))
(tu-eq "geruest-mm-string/dezimal" "17.5" (geruest-mm-string 17.5))
;; Variante darf Attribut-Felder ueberschreiben - auch mit false
(setq _bgtest (ssg-json-parse
"{\"attribute\": {\"LAENGENABZUGENDE\": {\"vorgabe\": 35, \"aktiv\": true}}}"))
(tu-eq "geruest-attr-feld/baugruppe" 35
(geruest-attr-feld nil _bgtest "LAENGENABZUGENDE" "vorgabe"))
(tu-eq "geruest-attr-feld/variante" 50
(geruest-attr-feld
(ssg-json-parse "{\"attribute\": {\"LAENGENABZUGENDE\": {\"vorgabe\": 50}}}")
_bgtest "LAENGENABZUGENDE" "vorgabe"))
(tu-nil "geruest-attr-feld/variante-false"
(geruest-attr-feld
(ssg-json-parse "{\"attribute\": {\"LAENGENABZUGENDE\": {\"aktiv\": false}}}")
_bgtest "LAENGENABZUGENDE" "aktiv"))
;; --- Rohr-Geruest-Traeger in der echten Datendatei ---
;; Eigene Datei data/json/geruest_traeger.json: in geruest.json darf er
;; nicht stehen, ueber geruest-traeger-daten muss er auffindbar sein.
(tu-true "geruest/traeger-datei"
(findfile (geruest-json-pfad "geruest_traeger.json")))
(setq _traeger (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
(tu-true "geruest/traeger-vorhanden" _traeger)
(tu-nil "geruest/traeger-nicht-in-geruest-json"
(geruest-baugruppe "Traeger" (geruest-daten)))
(if _traeger
(progn
(tu-eq "geruest/traeger-varianten-artikel" 0
(tu-geruest-artikel-unvollstaendig
(ssg-json-get _traeger "geometrie_varianten")))
(tu-true "geruest/traeger-layer"
(geruest-variante-wert
(car (ssg-json-get _traeger "geometrie_varianten"))
_traeger "layer"))
(tu-eq "geruest/traeger-max" 6000
(geruest-attr-feld nil _traeger "LAENGE" "max"))
(tu-eqf "geruest/traeger-querstrebe"
'("dummy_Strebe_30x4.dwg" 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq _traeger))
;; Querstreben-Flag je Variante: alle ausser den beiden Rohr-1"-Varianten
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(if (geruest-traeger-strebe-cfg _v _traeger) (setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-querstreben-varianten" 6 _rec)
(tu-nil "geruest/traeger-rohr-ohne-querstrebe"
(geruest-traeger-strebe-cfg
(car (ssg-json-get _traeger "geometrie_varianten")) _traeger))
;; Muffen-Flag ausdruecklich je Variante: genau die "mit (2) Muffe(n)"
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(if (geruest-traeger-muffe-dummy _v _traeger) (setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-muffen-varianten" 4 _rec)
;; Dialog: ein Radiobutton je Variante, auch fuer die mit Muffe
(tu-eq "geruest/traeger-radiobuttons" 8
(length (geruest-dcl-varianten-zeilen
(ssg-json-get _traeger "geometrie_varianten")
(geruest-indizes (length (ssg-json-get _traeger
"geometrie_varianten"))))))
;; Jede Variante definiert Beschriftungstext UND -layer selbst - der
;; Layer ist je Traegervariante verschieden, eine Vorgabe der
;; Baugruppe gibt es dafuer bewusst nicht.
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(setq _cfg (geruest-traeger-beschr-cfg _v _traeger ""))
(if (and (geruest-obj-feld _v _traeger '("beschriftung") "text")
(/= (cdr (assoc "text" _cfg)) "")
(geruest-json-pfad-get _v '("beschriftung" "layer"))
(geruest-ausrichtung-codes (cdr (assoc "ausrichtung" _cfg))))
(setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-beschriftung-varianten"
(length (ssg-json-get _traeger "geometrie_varianten")) _rec)
;; VARIANTE gehoert zum Traeger-Schema (Grundlage fuer das Neubeschriften)
(tu-true "geruest/traeger-attrib-variante"
(assoc "VARIANTE" *geruest-traeger-attrib-defs*))
;; Beide Dummy-DWGs liegen unter data/geruest
(tu-true "geruest/traeger-strebe-dwg"
(findfile (geruest-dummy-pfad "dummy_Strebe_30x4.dwg")))
(tu-true "geruest/traeger-muffe-dwg"
(findfile (geruest-dummy-pfad "dummy_Muffe_1zoll.dwg")))
)
)
;; --- Omniflo-Fahrstrecke (data/json/omniflo_fahrstrecke.json) ---
;; Gleiche Linien-Logik wie der Traeger: jede Variante ein Radiobutton,
;; nur ST/STL gibt es mit Muffen, nur ST/STL sind farbig.
(setq _fs (geruest-baugruppe "Fahrstrecke" (geruest-fahrstrecke-daten)))
(tu-true "fahrstrecke/vorhanden" _fs)
(if _fs
(progn
(setq _rec (ssg-json-get _fs "geometrie_varianten"))
(tu-eq "fahrstrecke/titel" "Fahrstrecke" (geruest-titel _fs))
(tu-eq "fahrstrecke/varianten"
'("AP 110" "APG 110" "AP 60" "ST" "ST mit Muffen" "STL" "STL mit Muffen")
(mapcar 'geruest-eintrag-name _rec))
(tu-eq "fahrstrecke/mit-muffe" '("ST mit Muffen" "STL mit Muffen")
(mapcar 'geruest-eintrag-name
(vl-remove-if-not '(lambda (v) (ssg-json-get v "mit_muffe")) _rec)))
;; AP 110 ohne "farbig" -> leerer TEILEFARBE-Eintrag, ST farbig
(tu-eq "fahrstrecke/ap110-nicht-farbig" '("")
(geruest-farbliste (geruest-teile-paare (nth 0 _rec) nil) "RAL7035"))
(tu-eq "fahrstrecke/st-farbig" '("RAL7035")
(geruest-farbliste
(geruest-teile-paare
(nth (geruest-name-index "ST" _rec) _rec) nil)
"RAL7035"))
;; Keine Querstreben; Muffen-Dummy wie beim Traeger nur bei den
;; Varianten mit "mit_muffe": true
(tu-nil "fahrstrecke/ohne-querstrebe"
(geruest-traeger-strebe-cfg (nth (geruest-name-index "ST" _rec) _rec) _fs))
(tu-eq "fahrstrecke/muffe-dummy" "dummy_Muffe_1zoll.dwg"
(geruest-traeger-muffe-dummy
(nth (geruest-name-index "ST mit Muffen" _rec) _rec) _fs))
(tu-nil "fahrstrecke/ohne-muffe-dummy"
(geruest-traeger-muffe-dummy
(nth (geruest-name-index "ST" _rec) _rec) _fs))
)
)
(tu-true "fahrstrecke/dcl-vorlage"
(findfile (geruest-dcl-vorlage-pfad "fahrstrecke.dcl")))
;; --- 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 "befestigung" (list (list (cons "artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL")
(cons "anzahl" 2))))
(cons "sonstiges" nil)
(cons "winkel_platte" 90)))
(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/befestigung-artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL"
(ssg-json-get (car (ssg-json-get _zurueck "befestigung")) "artikel"))
(tu-eq "geruest-schreiber/befestigung-anzahl" 2
(ssg-json-get (car (ssg-json-get _zurueck "befestigung")) "anzahl"))
(tu-eq "geruest-schreiber/sonstiges-leer" nil
(ssg-json-get _zurueck "sonstiges"))
(tu-eq "geruest-schreiber/winkel" 90
(ssg-json-get _zurueck "winkel_platte"))
;; altes Format wird nicht mehr geschrieben
(tu-nil "geruest-schreiber/ohne-oben" (assoc "oben" _zurueck))
)
)
)
;; ------------------------------------------------------------
;; 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))))
)
;; ------------------------------------------------------------
;; TESTS: ssg_input / ssg_blocktools / ssg_texttools - reine Funktionen
;; (die interaktiven Befehle SSG_BLOCK_*, SSG_ATTR_ERSETZEN, SSG_TEXT_*
;; brauchen eine Zeichnung und sind hier NICHT abgedeckt)
;; ------------------------------------------------------------
(defun tu-tests-werkzeuge ( / _e)
(princ "\n[ssg_input / ssg_blocktools / ssg_texttools / ssg_stueckliste]")
(if (not (and (car (atoms-family 1 '("SSG-IN-DEFAULT")))
(car (atoms-family 1 '("SSG-BT-WERT-NEU")))
(car (atoms-family 1 '("SSG-TT-LESBARER-WINKEL")))
(car (atoms-family 1 '("SSG-SL-KLASSE")))))
(tu-record nil "werkzeuge/geladen"
"ssg_input/ssg_blocktools/ssg_texttools/ssg_stueckliste nicht geladen (ssg_load.lsp)")
(progn
;; --- ssg_input ---
(tu-eqf "ssg-in-default/vorgabe" 5.0 (ssg-in-default nil 5.0))
(tu-eqf "ssg-in-default/eingabe" 3.0 (ssg-in-default 3.0 5.0))
(tu-nil "ssg-in-default/beides-nil" (ssg-in-default nil nil))
(tu-eq "ssg-in-fmt-real/ganz" "5" (ssg-in-fmt-real 5.0))
(tu-eq "ssg-in-fmt-real/halb" "2.5" (ssg-in-fmt-real 2.5))
(tu-eq "ssg-in-fmt-real/null" "0" (ssg-in-fmt-real 0.0))
(tu-eq "ssg-in-fmt-real/hundert" "100" (ssg-in-fmt-real 100.0))
(tu-eq "ssg-in-fmt-real/bruch" "0.125" (ssg-in-fmt-real 0.125))
(tu-eq "ssg-in-fmt-real/negativ" "-1.5" (ssg-in-fmt-real -1.5))
(tu-eq "ssg-in-fmt-pt/3d" "1,2.5,0" (ssg-in-fmt-pt '(1.0 2.5 0.0)))
(tu-eq "ssg-in-fmt-pt/2d" "1,2,0" (ssg-in-fmt-pt '(1.0 2.0)))
(tu-eq "ssg-in-prompt/mit-vorgabe" "\nHoehe <5>: " (ssg-in-prompt "\nHoehe" "5"))
(tu-eq "ssg-in-prompt/ohne" "\nHoehe: " (ssg-in-prompt "\nHoehe" nil))
(tu-eq "ssg-in-first-word" "Ja" (ssg-in-first-word "Ja Nein"))
(tu-eq "ssg-in-first-word/ein-wort" "Ja" (ssg-in-first-word "Ja"))
(tu-eq "ssg-in-second-word" "Nein" (ssg-in-second-word "Ja Nein"))
(tu-eq "ssg-in-second-word/ein-wort" "" (ssg-in-second-word "Ja"))
;; --- ssg_blocktools ---
(tu-true "ssg-bt-name-passt-p/muster" (ssg-bt-name-passt-p "GR_TR_1" "gr_*"))
(tu-nil "ssg-bt-name-passt-p/kein" (ssg-bt-name-passt-p "GR_TR_1" "XX*"))
(tu-true "ssg-bt-name-passt-p/nil" (ssg-bt-name-passt-p "ABC" nil))
(tu-true "ssg-bt-name-passt-p/leer" (ssg-bt-name-passt-p "ABC" ""))
(tu-true "ssg-bt-name-passt-p/escape-ja" (ssg-bt-name-passt-p "A.B" "A`.B"))
(tu-nil "ssg-bt-name-passt-p/escape-nein" (ssg-bt-name-passt-p "AxB" "A`.B"))
(tu-eq "ssg-bt-muster-escape" "A`.B`#1" (ssg-bt-muster-escape "A.B#1"))
(tu-eq "ssg-bt-muster-anzeige" "A.B#1" (ssg-bt-muster-anzeige "A`.B`#1"))
(tu-eq "ssg-bt-zaehle-namen"
'(("Alpha" . 1) ("Beta" . 1) ("Zeta" . 3))
(ssg-bt-zaehle-namen '("Zeta" "Alpha" "Zeta" "Beta" "Zeta")))
(tu-nil "ssg-bt-zaehle-namen/leer" (ssg-bt-zaehle-namen nil))
(tu-eq "ssg-bt-wert-neu/teil" "ABC_1" (ssg-bt-wert-neu "ABC-1" "-" "_" T))
(tu-eq "ssg-bt-wert-neu/mehrfach" "a.b.c" (ssg-bt-wert-neu "a-b-c" "-" "." T))
(tu-eq "ssg-bt-wert-neu/loeschen" "AC" (ssg-bt-wert-neu "ABC" "B" "" T))
(tu-nil "ssg-bt-wert-neu/kein-treffer" (ssg-bt-wert-neu "ABC" "X" "y" T))
(tu-eq "ssg-bt-wert-neu/gesamt-ja" "X" (ssg-bt-wert-neu "ABC" "ABC" "X" nil))
(tu-nil "ssg-bt-wert-neu/gesamt-nein" (ssg-bt-wert-neu "ABCD" "ABC" "X" nil))
(tu-nil "ssg-bt-wert-neu/leere-suche" (ssg-bt-wert-neu "ABC" "" "X" T))
(tu-nil "ssg-bt-wert-neu/gross-klein" (ssg-bt-wert-neu "abc" "ABC" "X" T))
;; --- ssg_texttools ---
(tu-eqf "ssg-tt-lesbarer-winkel/0" 0.0 (ssg-tt-lesbarer-winkel 0.0))
(tu-eqf "ssg-tt-lesbarer-winkel/45" (/ pi 4.0) (ssg-tt-lesbarer-winkel (/ pi 4.0)))
(tu-eqf "ssg-tt-lesbarer-winkel/90" (/ pi 2.0) (ssg-tt-lesbarer-winkel (/ pi 2.0)))
(tu-eqf "ssg-tt-lesbarer-winkel/135" (* 1.75 pi) (ssg-tt-lesbarer-winkel (* 0.75 pi)))
(tu-eqf "ssg-tt-lesbarer-winkel/180" 0.0 (ssg-tt-lesbarer-winkel pi))
(tu-eqf "ssg-tt-lesbarer-winkel/270" (/ pi 2.0) (ssg-tt-lesbarer-winkel (* 1.5 pi)))
(tu-eqf "ssg-tt-lesbarer-winkel/-45" (* 1.75 pi) (ssg-tt-lesbarer-winkel (- (/ pi 4.0))))
(tu-eqf "ssg-tt-lesbarer-winkel/360" 0.0 (ssg-tt-lesbarer-winkel (* 2.0 pi)))
(tu-eqf "ssg-tt-versetzt/x" '(5.0 0.0 0.0) (ssg-tt-versetzt '(0.0 0.0 0.0) 0.0 5.0))
(tu-eqf "ssg-tt-versetzt/y" '(0.0 2.0 0.0) (ssg-tt-versetzt '(0.0 0.0 0.0) (/ pi 2.0) 2.0))
(tu-eqf "ssg-tt-versetzt/2d" '(1.0 4.0 0.0) (ssg-tt-versetzt '(1.0 1.0) (/ pi 2.0) 3.0))
;; --- ssg_stueckliste: ssg-sl-klasse (Elementerkennung) ---
(tu-eq "ssg-sl-klasse/kreisel" "ils_kreisel" (car (ssg-sl-klasse "KREISEL_1_STANDARD_2300")))
(tu-eq "ssg-sl-klasse/eckrad" "ils_kreisel" (car (ssg-sl-klasse "ECKRAD_3")))
(tu-eq "ssg-sl-klasse/vf" "ils_strecke" (car (ssg-sl-klasse "VF_2")))
(tu-eq "ssg-sl-klasse/gf" "ils_strecke" (car (ssg-sl-klasse "GF_1")))
(tu-eq "ssg-sl-klasse/geruest" "geruest" (car (ssg-sl-klasse "GR_Saeulen_20260101120000")))
(tu-eq "ssg-sl-klasse/fahrstrecke" "fahrstrecke" (car (ssg-sl-klasse "GR_Fahrstrecke_20260101120000")))
(tu-eq "ssg-sl-klasse/ap60" "ap60" (car (ssg-sl-klasse "AP60_20260101120000")))
(tu-eq "ssg-sl-klasse/apg110" "apg110" (car (ssg-sl-klasse "APG110_20260101120000")))
(tu-eq "ssg-sl-klasse/ap110" "ap110" (car (ssg-sl-klasse "AP110_20260101120000")))
(tu-eq "ssg-sl-klasse/ap_110" "ap110" (car (ssg-sl-klasse "AP_110_20260101120000")))
(tu-eq "ssg-sl-klasse/klein" "ap60" (car (ssg-sl-klasse "ap60_test")))
(tu-nil "ssg-sl-klasse/unbekannt" (ssg-sl-klasse "SONSTIGER_BLOCK"))
;; Leerer/nil Auswahlsatz -> keine Elemente (der Treffer-Pfad braucht
;; echte Entities und ist nur im Szenario-Test abgedeckt).
(tu-nil "ssg-sl-elemente-aus-ss/nil" (ssg-sl-elemente-aus-ss nil))
;; ssg-sl-gruppieren-werte = reiner Kern ohne Zeichnungszugriff; die
;; Laengenermittlung aus der Zeichnung ist in ssg-sl-gruppieren getrennt.
(tu-eq "ssg-sl-gruppieren-werte/zaehlung-und-summe"
'(("a" "Bez-A" 2 300.0) ("b" "Bez-B" 1 50.0))
(ssg-sl-gruppieren-werte
(list (list "a" "Bez-A" 100.0)
(list "b" "Bez-B" 50.0)
(list "a" "Bez-A" 200.0))))
(tu-nil "ssg-sl-gruppieren-werte/leer" (ssg-sl-gruppieren-werte nil))
)
)
)
(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-etage" "tu-tests-vfl-es" "tu-tests-vfl-ziellinie"
"tu-tests-export" "tu-tests-hoehen" "tu-tests-gf" "tu-tests-omni" "tu-tests-kreisel" "tu-tests-kreisel-bp"
"tu-tests-sepliste" "tu-tests-json" "tu-tests-geruest"
"tu-tests-sepscan" "tu-tests-vfl-segs" "tu-tests-vfl-abbruch"
"tu-tests-werkzeuge")
(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)
Reference in New Issue View Git Blame Copy Permalink