From ee5a4550a4c80b385db49635c019e719f605d7f8 Mon Sep 17 00:00:00 2001 From: Terrence Henry Date: Sat, 3 Oct 2026 18:36:20 +0200 Subject: [PATCH] Guard schematic TextColor access before touching Altium objects --- .github/workflows/tests.yml | 2 +- docs/RELEASE_VERIFICATION.md | 57 ++++++- scripts/altium/Generic.pas | 92 ++++++++++- scripts/altium/Main.pas | 2 +- ...st_sch_properties_match_their_interface.py | 35 +++- tests/test_sch_textcolor.py | 149 ++++++++++++++++++ 6 files changed, 321 insertions(+), 16 deletions(-) create mode 100644 tests/test_sch_textcolor.py diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index ecfb356..2c00d2b 100644 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -116,7 +116,7 @@ jobs: # unrun for exactly the reason this job exists. - name: Pascal and Python helpers agree run: | - python -m pytest tests/test_cross_validate.py tests/test_pascal_runner.py tests/test_sch_properties_match_their_interface.py -q -rs --durations=10 | Tee-Object -Variable captured + python -m pytest tests/test_cross_validate.py tests/test_pascal_runner.py tests/test_sch_properties_match_their_interface.py tests/test_sch_textcolor.py -q -rs --durations=10 | Tee-Object -Variable captured # Read the exit code BEFORE anything else runs. Piping a native # command into Tee-Object means the step's own success is the # pipeline's, not pytest's, so without this a failing diff --git a/docs/RELEASE_VERIFICATION.md b/docs/RELEASE_VERIFICATION.md index 4420831..ea42a93 100644 --- a/docs/RELEASE_VERIFICATION.md +++ b/docs/RELEASE_VERIFICATION.md @@ -1,4 +1,4 @@ -# Release verification: 2026.10.01.1 +# Release verification: 2026.10.03.1 Unless a section records live verification explicitly, the Pascal below has been checked by FPC and the linter but **not executed by Altium's DelphiScript engine**. The two are not the @@ -210,7 +210,7 @@ objects you can delete afterwards. app_ping ``` -Expect `altium_script_version` = `2026.10.01.1`, `version_match` = +Expect `altium_script_version` = `2026.10.03.1`, `version_match` = `true`, and `mcp_server_version` = `0.6.1`. Those are two different versions and they fail differently. @@ -1242,7 +1242,7 @@ names and sheet file names, the types whose interface declares it; `Text` is refused on the types whose interface has none, wires among them. Repeat steps 3 to 7 on AD 26 with the wire included. -Verified on AD 26.10.1.6 with script 2026.10.01.1: the three reads return +Verified on AD 26.10.1.6 with script 2026-10-01 revision 1: the three reads return empty fields listed under `properties.unreadable`, `IsHidden=true` on a wire is refused under `properties.unknown`, `IsHidden` reads and writes on parameters, and the bridge answered `app_ping` after each call. @@ -1259,7 +1259,7 @@ Single creation returns `UNSUPPORTED_PROPERTY` with the property and object type in the error message. Batch creation rejects only that item, without registering it, and includes `reason: "UNSUPPORTED_PROPERTY"`, `property`, `object_type`, and the zero-based `index` in `failures`. Valid items continue. -This preflight covers the guarded Text and IsHidden combinations, not every +This preflight covers the guarded Text, IsHidden and TextColor combinations, not every unknown property. Existing inputs and successful response fields are unchanged. Use visible net labels with `Text`; do not hide them with `IsHidden`. Query a @@ -1300,7 +1300,9 @@ Repeatable acceptance, on a disposable schematic only: Do the same for `IsHidden` and `Text` on a wire. 4. Attempt those writes with `obj_modify` and `obj_batch_modify`. Expect failure diagnostics, unchanged objects, and no modal. These operations - retain existing partial-write semantics for other valid assignments. + preflight the complete assignment list for known unsupported Text, + IsHidden and TextColor pairs before writing any other field. Unknown + names outside that preflight retain the existing partial-write semantics. 5. Attempt each unsupported pair through `obj_create` and `obj_batch_create`. Verify failed objects are absent. In a batch containing invalid, valid, invalid, and valid items, expect two creations, two indexed failures and @@ -1312,3 +1314,48 @@ Repeatable acceptance, on a disposable schematic only: Record exact Altium and bridge versions, responses, and object counts. Offline source guards and Free Pascal tests do not establish live Altium acceptance. + +## TextColor property rejection + +Recorded on AD 21.4.1.30 with script 2026-10-01 revision 1 on 2026-10-03: +`obj_query` on an existing `ePowerObject` with `Text,Color,TextColor` raised +`Undeclared identifier: TextColor` at the generic getter and stopped polling. +The setter had the same unguarded access. See issue #37. + +The candidate script 2026.10.03.1 allows TextColor only on ports, sheet entries +and harness entries and uses their typed interfaces. Altium's [schematic API +reference](https://www.altium.com/documentation/altium-dxp-developer/schematic-api-design-objects-interfaces-reference) +documents those owners; power objects use Color. The bridge never substitutes +Color for a rejected TextColor request. + +Queries retain other fields and report unsupported TextColor under +`properties.unreadable`, including project scope. Filters using a known +unsupported property return no match before reading it; an empty expected +value must not turn an unreadable property into a match. Modifications reject +the complete assignment list before applying a positional or other write. +Creation retains the existing single error and indexed batch-failure formats. + +Repeatable live acceptance on disposable documents: + +1. Reload the script project and verify ping reports 2026.10.03.1. Create a + power object, a net label, a port, and a sheet symbol with a sheet entry. +2. Query TextColor alongside valid fields on the power object and net label. + Expect empty TextColor fields with unreadable diagnostics. Repeat with + document and disposable-project scopes. +3. Filter the power object with `TextColor=` and `TextColor=128`. Expect no + matches, including a delete using that filter; verify the object remains. +4. Attempt `Color=123|Location.X=100|TextColor=128` through single and batch + modification. Expect rejection diagnostics and unchanged Color/position. + Include a valid independent batch item and verify it completes. +5. Attempt single creation and a mixed batch containing two unsupported + power-object items and two valid items. Expect no invalid objects, two + indexed failures, and exactly two valid creations. +6. Read/write/read TextColor on a port and sheet entry. Save ONLY the scratch + document, close/reopen it, and verify persistence. Harness-entry support + must be checked on a fixture that actually contains one; it is not exposed + by the current generic object-type mapping. +7. Ping and perform a valid query after each rejection. No error dialog, + debugger stop, or polling restart may be needed. Restore editor focus and + close the disposable documents at the end. + +Live results for this candidate are recorded below once performed. diff --git a/scripts/altium/Generic.pas b/scripts/altium/Generic.pas index fb3b680..340c542 100644 --- a/scripts/altium/Generic.pas +++ b/scripts/altium/Generic.pas @@ -190,6 +190,18 @@ Or (Obj.ObjectId = eSheetFileName); End; +{ TextColor belongs to ports, sheet entries and harness entries, not to + ISch_GraphicalObject or ISch_Label. Reading it on a power object raises + an undeclared-identifier modal BEFORE Try/Except can recover (AD 21.4). + https://www.altium.com/documentation/altium-dxp-developer/schematic-api-design-objects-interfaces-reference } +Function SchObjectHasTextColor(Obj : ISch_GraphicalObject) : Boolean; +Begin + Result := False; + If Obj = Nil Then Exit; + Result := (Obj.ObjectId = ePort) Or (Obj.ObjectId = eSheetEntry) + Or (Obj.ObjectId = eHarnessEntry); +End; + { Preflight only the known unsupported property/type pairs. Preserve the existing treatment of other names; do not guess a complete capability map. } Function UnsupportedSchProperty(Obj : ISch_GraphicalObject; SetStr : String) : String; @@ -217,7 +229,8 @@ Begin PropName := Copy(Assignment, 1, EqPos - 1); If ((PropName = 'Text') And (Not SchObjectHasText(Obj))) - Or ((PropName = 'IsHidden') And (Not SchObjectHasIsHidden(Obj))) Then + Or ((PropName = 'IsHidden') And (Not SchObjectHasIsHidden(Obj))) + Or ((PropName = 'TextColor') And (Not SchObjectHasTextColor(Obj))) Then Begin Result := PropName; Exit; @@ -477,6 +490,9 @@ R : ISch_Rectangle; L : ISch_Line; Comp : ISch_Component; + PortObj : ISch_Port; + EntryObj : ISch_SheetEntry; + HarnessEntryObj : ISch_HarnessEntry; Crn : TLocation; Have : Boolean; POrient, PLen, PCoord : Integer; @@ -606,7 +622,29 @@ Else If PropName = 'Electrical' Then Result := PinElectricalToStr(Obj.Electrical) Else If PropName = 'Color' Then Result := IntToStr(Obj.Color) Else If PropName = 'AreaColor' Then Result := IntToStr(Obj.AreaColor) - Else If PropName = 'TextColor' Then Result := IntToStr(Obj.TextColor) + Else If PropName = 'TextColor' Then + Begin + If SchObjectHasTextColor(Obj) Then + Begin + If Obj.ObjectId = ePort Then + Begin + PortObj := Obj; + Result := IntToStr(PortObj.TextColor); + End + Else If Obj.ObjectId = eSheetEntry Then + Begin + EntryObj := Obj; + Result := IntToStr(EntryObj.TextColor); + End + Else + Begin + HarnessEntryObj := Obj; + Result := IntToStr(HarnessEntryObj.TextColor); + End; + End + Else + NotePropertyDiag('unreadable', PropName); + End Else If PropName = 'Justification' Then Result := IntToStr(Obj.Justification) { A SHEET ENTRY'S POSITION ON THE SYMBOL. Both read empty before, because neither had a case here, so a caller checking whether a @@ -733,6 +771,9 @@ R : ISch_Rectangle; L : ISch_Line; Comp : ISch_Component; + PortObj : ISch_Port; + EntryObj : ISch_SheetEntry; + HarnessEntryObj : ISch_HarnessEntry; Matched : Boolean; { Separate from Matched on purpose. Matched says the property NAME is one this build writes; WroteOK says the value actually landed, read @@ -916,7 +957,29 @@ Else If PropName = 'Electrical' Then Obj.Electrical := ElectricalOrdinal(Value) Else If PropName = 'Color' Then Obj.Color := StrToIntDef(Value, 0) Else If PropName = 'AreaColor' Then Obj.AreaColor := StrToIntDef(Value, 0) - Else If PropName = 'TextColor' Then Obj.TextColor := StrToIntDef(Value, 0) + Else If PropName = 'TextColor' Then + Begin + If SchObjectHasTextColor(Obj) Then + Begin + If Obj.ObjectId = ePort Then + Begin + PortObj := Obj; + PortObj.TextColor := StrToIntDef(Value, 0); + End + Else If Obj.ObjectId = eSheetEntry Then + Begin + EntryObj := Obj; + EntryObj.TextColor := StrToIntDef(Value, 0); + End + Else + Begin + HarnessEntryObj := Obj; + HarnessEntryObj.TextColor := StrToIntDef(Value, 0); + End; + End + Else + Matched := False; + End Else If PropName = 'Justification' Then Obj.Justification := StrToIntDef(Value, 0) // Coord properties (expected in mils) @@ -1071,6 +1134,15 @@ PropName := Copy(Condition, 1, EqPos - 1); Expected := Copy(Condition, EqPos + 1, Length(Condition)); + { An unreadable property is not an empty value. In particular, + TextColor= must never match power objects in a delete/filter. } + If UnsupportedSchProperty(Obj, Condition) <> '' Then + Begin + NotePropertyDiag('unreadable', PropName); + Result := False; + Exit; + End; + // Compare Actual := GetSchProperty(Obj, PropName); If Actual <> Expected Then @@ -1139,13 +1211,22 @@ { (a net label in particular must NOT go through MoveToXY -- it has no } { MoveToXY and is not a component). } Var - Remaining, Assignment, PropName, PropValue : String; + Remaining, Assignment, PropName, PropValue, UnsupportedProp : String; PipePos, EqPos : Integer; Loc : TLocation; Comp : ISch_Component; HasX, HasY : Boolean; NewX, NewY : Integer; Begin + { Reject the whole assignment list before even the coalesced move. + Otherwise Location/Color can change before a later TextColor fails. } + UnsupportedProp := UnsupportedSchProperty(Obj, SetStr); + If UnsupportedProp <> '' Then + Begin + NotePropertyDiag('unknown', UnsupportedProp); + Exit; + End; + { Pass 1: collect the positional assignments without applying anything. } HasX := False; HasY := False; @@ -1660,7 +1741,8 @@ If Mode = 'query' Then Result := BuildSuccessResponse(RequestId, '{"objects":[' + JsonItems + '],"count":' + IntToStr(TotalMatched) + - ',"sheets_processed":' + IntToStr(SheetsProcessed) + '}') + ',"sheets_processed":' + IntToStr(SheetsProcessed) + + ',"properties":' + RenderPropertyDiagJson(0) + '}') Else Result := BuildSuccessResponse(RequestId, '{"matched":' + IntToStr(TotalMatched) + diff --git a/scripts/altium/Main.pas b/scripts/altium/Main.pas index 1322d59..96fb2f5 100644 --- a/scripts/altium/Main.pas +++ b/scripts/altium/Main.pas @@ -13,7 +13,7 @@ // returns, mismatch means Altium is running a stale compiled script // (DelphiScript caches compiled units until the script project is // reopened or Altium is restarted). - SCRIPT_VERSION = '2026.10.01.1'; + SCRIPT_VERSION = '2026.10.03.1'; // How far up the mechanical layers a pair tidy looks. Altium allows 1024, // and checking every combination of those is a million probes for a stack diff --git a/tests/test_sch_properties_match_their_interface.py b/tests/test_sch_properties_match_their_interface.py index 5713e51..8dd75f2 100644 --- a/tests/test_sch_properties_match_their_interface.py +++ b/tests/test_sch_properties_match_their_interface.py @@ -259,15 +259,21 @@ def test_extracted_pascal_capabilities_and_creation_preflight(tmp_path): pytest.skip("Free Pascal Compiler (fpc) is not installed or not on PATH") source = _source() routines = "\n".join(_routine(source, name) for name in - ("SchObjectHasText", "SchObjectHasIsHidden", + ("SchObjectHasText", "SchObjectHasIsHidden", "SchObjectHasTextColor", "UnsupportedSchProperty")) # Match all identifiers used by the real guards, so existing denylist # exclusions remain part of the executable test. types = sorted(set(re.findall(r"\be[A-Z]\w*", routines)) | - {"eNetLabel", "eParameterSet", "eParameter", "ePort", "eSheetEntry", + {"eNetLabel", "eParameterSet", "eParameter", "ePowerObject", "ePort", "eSheetEntry", "eWire", "ePin", "eLabel"}) constants = "\n".join(f" {name} = {i};" for i, name in enumerate(types)) checks = [ + ("ePowerObject", "TextColor=128", "TextColor"), + ("ePowerObject", "Location.X=10|Color=128|TextColor=0", "TextColor"), + ("ePowerObject", "Color=128", ""), + ("ePort", "TextColor=128", ""), + ("eSheetEntry", "TextColor=128", ""), + ("eHarnessEntry", "TextColor=128", ""), ("eParameterSet", "Text=bad", "Text"), ("eParameterSet", "Location.X=10|Text=bad|Location.Y=20", "Text"), ("eParameterSet", "Location.X=10|Location.Y=20", ""), @@ -318,7 +324,7 @@ def test_extracted_pascal_single_and_mixed_batch_creation(tmp_path): source = _source() main = MAIN.read_text(encoding="utf-8") guards = "\n".join(_routine(source, name) for name in - ("SchObjectHasText", "SchObjectHasIsHidden", "UnsupportedSchProperty")) + ("SchObjectHasText", "SchObjectHasIsHidden", "SchObjectHasTextColor", "UnsupportedSchProperty")) creators = "\n".join(_routine(source, name) for name in ("Gen_CreateObject", "Gen_BatchCreate")) parsers = "\n".join(_routine(main, name) for name in ("NextBatchOp", "GetBatchField")) @@ -396,6 +402,7 @@ def test_extracted_pascal_single_and_mixed_batch_creation(tmp_path): if S='eParameterSet' then Result:=eParameterSet; if S='eNetLabel' then Result:=eNetLabel; if S='eParameter' then Result:=eParameter; + if S='ePowerObject' then Result:=ePowerObject; end; function UnknownObjectTypeMessage(S: String): String; begin Result := S; end; @@ -408,7 +415,7 @@ def test_extracted_pascal_single_and_mixed_batch_creation(tmp_path): ''' # Every type the guards name, so a longer list still compiles. kinds = sorted(set(re.findall(r"\be[A-Z]\w*", guards)) | - {"ePort", "eSheetEntry", "eParameterSet", "eNetLabel", "eParameter", "eSchLib"}) + {"ePort", "eSheetEntry", "eParameterSet", "eNetLabel", "eParameter", "ePowerObject", "eSchLib"}) stubs = stubs.replace("@@TYPES@@", " ".join(f"{k}={n};" for n, k in enumerate(kinds, 1))) transport = r''' function ExtractJsonValue(Params, Key: String): String; @@ -452,6 +459,16 @@ def test_extracted_pascal_single_and_mixed_batch_creation(tmp_path): PrintCounts; WriteLn(Gen_CreateObject('object_type=eParameter;properties=IsHidden=true', '5')); PrintCounts; + RegisteredCount:=0; DestroyedCount:=0; AppliedCount:=0; ResetCount:=0; + WriteLn(Gen_CreateObject('object_type=ePowerObject;properties=Color=123|TextColor=128', '6')); + PrintCounts; + RegisteredCount:=0; DestroyedCount:=0; AppliedCount:=0; ResetCount:=0; + WriteLn(Gen_BatchCreate( + 'object_type=ePowerObject;properties=TextColor=128~~' + + 'object_type=ePowerObject;properties=Text=GOOD|Color=123~~' + + 'object_type=ePowerObject;properties=Location.X=10|TextColor=128~~' + + 'object_type=eNetLabel;properties=Text=GOOD', '7')); + PrintCounts; end. ''' path = tmp_path / "creation_regression.pas" @@ -479,3 +496,13 @@ def test_extracted_pascal_single_and_mixed_batch_creation(tmp_path): assert lines[7] == "2,2,2,5" assert json.loads(lines[8]) == {"created": True, "object_type": "eParameter"} assert lines[9] == "3,2,3,6" + assert json.loads(lines[10]) == {"code": "UNSUPPORTED_PROPERTY", "message": "Property TextColor is not supported on ePowerObject"} + assert lines[11] == "0,1,0,1" + assert json.loads(lines[12]) == { + "created": 2, "failed": 2, "total": 4, + "failures": [ + {"index": 0, "object_type": "ePowerObject", "reason": "UNSUPPORTED_PROPERTY", "property": "TextColor"}, + {"index": 2, "object_type": "ePowerObject", "reason": "UNSUPPORTED_PROPERTY", "property": "TextColor"}, + ], + } + assert lines[13] == "2,2,2,5" diff --git a/tests/test_sch_textcolor.py b/tests/test_sch_textcolor.py new file mode 100644 index 0000000..2839c86 --- /dev/null +++ b/tests/test_sch_textcolor.py @@ -0,0 +1,149 @@ +# SPDX-License-Identifier: Apache-2.0 +"""AD21 TextColor crash: exercise the real guards, not a permissive mock API.""" +from __future__ import annotations + +import re +import os +import shutil +import subprocess + +import pytest + +from tests.test_sch_properties_match_their_interface import _routine, _source + + +def _assert_textcolor_access(code): + capability = _routine(code, "SchObjectHasTextColor") + assert "Result := False" in capability + assert "If Obj = Nil Then Exit" in capability + assert set(re.findall(r"Obj\.ObjectId = (e\w+)", capability)) == { + "ePort", "eSheetEntry", "eHarnessEntry"} + # A typed local must be declared and assigned AFTER the capability check. + for routine in ("GetSchProperty", "SetSchProperty"): + body = _routine(code, routine) + branch = body.split("Else If PropName = 'TextColor' Then", 1)[1] + branch = re.split(r"\bElse If PropName\b", branch, maxsplit=1)[0] + guard = branch.index("If SchObjectHasTextColor(Obj) Then") + assert not re.search(r"\bObj\.TextColor\b", branch) + for local, interface in (("PortObj", "ISch_Port"), + ("EntryObj", "ISch_SheetEntry"), + ("HarnessEntryObj", "ISch_HarnessEntry")): + assert f"{local} : {interface}" in body + assert guard < branch.index(f"{local} := Obj") < branch.index(f"{local}.TextColor") + if routine == "GetSchProperty": + assert "NotePropertyDiag('unreadable', PropName)" in branch + else: + assert "Matched := False" in branch + + +def test_textcolor_uses_only_documented_typed_interfaces(): + _assert_textcolor_access(_source()) + + +@pytest.mark.parametrize("mutation", ["read_guard", "write_guard", "allow_power", "raw_read"]) +def test_textcolor_guard_detects_the_original_defect(mutation): + code = _source() + if mutation == "allow_power": + code = code.replace("(Obj.ObjectId = eHarnessEntry);", + "(Obj.ObjectId = eHarnessEntry) Or (Obj.ObjectId = ePowerObject);", 1) + elif mutation == "raw_read": + code = code.replace("IntToStr(PortObj.TextColor)", "IntToStr(Obj.TextColor)", 1) + else: + routine = "GetSchProperty" if mutation == "read_guard" else "SetSchProperty" + start = code.index(f"Function {routine}(") + code = code[:start] + code[start:].replace( + "If SchObjectHasTextColor(Obj) Then", "If True Then", 1) + with pytest.raises((AssertionError, ValueError)): + _assert_textcolor_access(code) + + +def _assert_preflight(code): + preflight = _routine(code, "UnsupportedSchProperty") + assert "(PropName = 'TextColor') And (Not SchObjectHasTextColor(Obj))" in preflight + apply = _routine(code, "ApplySetProperties") + check = apply.index("UnsupportedSchProperty(Obj, SetStr)") + assert check < apply.index("Loc := Obj.Location") + assert check < apply.index("SetSchProperty(Obj, PropName, PropValue)") + rejection = apply[check:apply.index("HasX := False")] + assert "NotePropertyDiag('unknown', UnsupportedProp)" in rejection + assert "Exit;" in rejection + filt = _routine(code, "MatchesFilter") + check = filt.index("UnsupportedSchProperty(Obj, Condition)") + read = filt.index("Actual := GetSchProperty") + assert check < read + rejection = filt[check:read] + assert "Result := False" in rejection and "Exit;" in rejection + + +def test_mixed_sets_and_empty_filters_are_preflighted(): + _assert_preflight(_source()) + + +@pytest.mark.parametrize("call", ["UnsupportedSchProperty(Obj, SetStr)", + "UnsupportedSchProperty(Obj, Condition)"]) +def test_preflight_regression_detects_removed_checks(call): + with pytest.raises((AssertionError, ValueError)): + _assert_preflight(_source().replace(call, "''")) + + +def test_project_queries_include_property_diagnostics(): + body = _routine(_source(), "IterateProjectDocs") + query = body.split("If Mode = 'query' Then", 1)[1].split("Else", 1)[0] + assert "RenderPropertyDiagJson(0)" in query + + +def test_production_textcolor_filters_do_not_read_missing_members(tmp_path): + """Compile production guards/filter with a getter that poisons bad reads.""" + fpc = shutil.which("fpc") + if not fpc: + pytest.skip("Free Pascal Compiler (fpc) is not installed or not on PATH") + names = ("SchObjectHasText", "SchObjectHasIsHidden", "SchObjectHasTextColor", + "UnsupportedSchProperty") + source = _source() + guards = "\n".join(_routine(source, name) for name in names) + types = sorted(set(re.findall(r"\be[A-Z]\w*", guards)) | {"ePowerObject", "eNetLabel"}) + constants = "\n".join(f"{kind}={i};" for i, kind in enumerate(types)) + program = """program textcolor_filters; +{$mode delphi} +uses SysUtils; +const @@CONSTANTS@@ +type ISch_GraphicalObject = class ObjectId: Integer; end; +var Reads, Diagnostics: Integer; +@@GUARDS@@ +procedure NotePropertyDiag(Kind, Prop: String); +begin Inc(Diagnostics); end; +function GetSchProperty(Obj: ISch_GraphicalObject; Prop: String): String; +begin + if (Prop='TextColor') and not SchObjectHasTextColor(Obj) then Halt(90); + Inc(Reads); + if Prop='TextColor' then Result:='128' else Result:='GND'; +end; +@@FILTER@@ +var Obj: ISch_GraphicalObject; +begin + if SchObjectHasTextColor(nil) then Halt(1); + Obj:=ISch_GraphicalObject.Create; + Obj.ObjectId:=ePowerObject; + if MatchesFilter(Obj, 'TextColor=') then Halt(2); + if MatchesFilter(Obj, 'TextColor=128') then Halt(3); + if (Reads<>0) or (Diagnostics<>2) then Halt(4); + if UnsupportedSchProperty(Obj, 'Color=123|Location.X=100|TextColor=128')<>'TextColor' then Halt(5); + if not MatchesFilter(Obj, 'Text=GND') then Halt(6); + Obj.ObjectId:=ePort; + if not MatchesFilter(Obj, 'TextColor=128') then Halt(7); + Obj.ObjectId:=eSheetEntry; + if not MatchesFilter(Obj, 'TextColor=128') then Halt(8); + Obj.ObjectId:=eHarnessEntry; + if not MatchesFilter(Obj, 'TextColor=128') then Halt(9); + if Reads<>4 then Halt(10); + Obj.Free; +end. +""".replace("@@CONSTANTS@@", constants).replace("@@GUARDS@@", guards).replace( + "@@FILTER@@", _routine(source, "MatchesFilter")) + path = tmp_path / "textcolor_filters.pas" + path.write_text(program, encoding="utf-8") + compiled = subprocess.run([fpc, str(path)], cwd=tmp_path, capture_output=True, text=True) + assert compiled.returncode == 0, compiled.stdout + compiled.stderr + executable = path.with_suffix(".exe" if os.name == "nt" else "") + result = subprocess.run([str(executable)], capture_output=True, text=True) + assert result.returncode == 0, result.stdout + result.stderr