diff --git a/Makefile b/Makefile index f7354e0..2009563 100644 --- a/Makefile +++ b/Makefile @@ -767,6 +767,12 @@ test-progress-ledger: | $(BUILDDIR) $(FPC) $(FPCFLAGS) src/tests/progress_ledger_tests.pas -o$(BUILDDIR)/progress_ledger_tests @$(BUILDDIR)/progress_ledger_tests +# Deterministic ## Project prompt section (stack/build/test/git from file reads). +test-project-facts: | $(BUILDDIR) + @mkdir -p $(BUILDDIR)/lib + $(FPC) $(FPCFLAGS) src/tests/project_facts_tests.pas -o$(BUILDDIR)/project_facts_tests + @$(BUILDDIR)/project_facts_tests + # Deterministic agent-loop harness bench (bench/agentloop) -- pure FPC, no # external runtime. Spawns the built binary, plays the scripted model over # the relay, asserts on what the loop did. Not part of `make test` (binds a @@ -846,4 +852,4 @@ test-fs-grep-tier5-6: | $(BUILDDIR) $(FPC) $(FPCFLAGS) src/tests/fs_grep_tier5_6_tests.pas -o$(BUILDDIR)/fs_grep_tier5_6_tests @$(BUILDDIR)/fs_grep_tier5_6_tests -test: smoke test-hashline test-toolview test-anthropic-server-tools test-openai-server-tools test-tool-choice test-responses-tool-choice test-println-helper test-utf8-codepage-tag test-gemini-schema-strip test-markdown-render test-json-utf8-roundtrip test-model-discovery test-cron-tool test-provider-catalog test-output-cache test-working-state test-ansi-width test-shell-filters test-learn test-export test-execute-code test-session-stats test-auto-router test-gateway-stats-buckets test-session-list-filter test-session-endpoints test-config-secret-merge test-skills-install test-self-improving-skills test-loop-shaping-defaults test-max-iter-notice test-max-iter-notice test-plan-build-mode test-config-profile test-tool-rpc test-session-search test-subagent-bg test-subagent-default test-stream-reliability test-mcp-server test-mcp-hub-projection test-checkpoints test-condense-json test-goals-runner test-kb-index test-kb-pdf test-agents-md test-checkpoints-zpaq test-orient-preamble test-component-config test-autoroute-apply test-fallback-models test-memory-distill test-memory-facts test-memory-autodistill test-checkpoints-redo test-build-roundtrip test-promptware test-orient test-condense-reversible test-heartbeat test-shell-backend test-env-inject test-run-timeout test-shell-output-decode test-fs-grep-tier1-4 test-fs-grep-tier5-6 test-fs-tool-naming test-workspace-paths test-progress-ledger test-otel test-logger-level-quiet test-gateway-token test-fs-secret-gate test-config-env-subst test-delphi-build +test: smoke test-hashline test-toolview test-anthropic-server-tools test-openai-server-tools test-tool-choice test-responses-tool-choice test-println-helper test-utf8-codepage-tag test-gemini-schema-strip test-markdown-render test-json-utf8-roundtrip test-model-discovery test-cron-tool test-provider-catalog test-output-cache test-working-state test-ansi-width test-shell-filters test-learn test-export test-execute-code test-session-stats test-auto-router test-gateway-stats-buckets test-session-list-filter test-session-endpoints test-config-secret-merge test-skills-install test-self-improving-skills test-loop-shaping-defaults test-max-iter-notice test-max-iter-notice test-plan-build-mode test-config-profile test-tool-rpc test-session-search test-subagent-bg test-subagent-default test-stream-reliability test-mcp-server test-mcp-hub-projection test-checkpoints test-condense-json test-goals-runner test-kb-index test-kb-pdf test-agents-md test-checkpoints-zpaq test-orient-preamble test-component-config test-autoroute-apply test-fallback-models test-memory-distill test-memory-facts test-memory-autodistill test-checkpoints-redo test-build-roundtrip test-promptware test-orient test-condense-reversible test-heartbeat test-shell-backend test-env-inject test-run-timeout test-shell-output-decode test-fs-grep-tier1-4 test-fs-grep-tier5-6 test-fs-tool-naming test-workspace-paths test-progress-ledger test-project-facts test-otel test-logger-level-quiet test-gateway-token test-fs-secret-gate test-config-env-subst test-delphi-build diff --git a/bench/agentloop/agentloop_bench.pas b/bench/agentloop/agentloop_bench.pas index 59e6951..844c7f9 100644 --- a/bench/agentloop/agentloop_bench.pas +++ b/bench/agentloop/agentloop_bench.pas @@ -93,6 +93,8 @@ function Has(const Hay, Needle: string): Boolean; GHandler: THandler; GEnvs: array of string; { raw envelopes, reset per scenario } GMaxBody: Integer; { max envelope bytes, reset per scenario } + GTotalBody: Int64; { sum of envelope bytes, reset per scenario } + GStep: Integer; { policy-model state for ScenarioRealTask } procedure ResetScenario(H: THandler); begin @@ -101,6 +103,8 @@ procedure ResetScenario(H: THandler); GHandler := H; SetLength(GEnvs, 0); GMaxBody := 0; + GTotalBody := 0; + GStep := 0; finally GLock.Release; end; @@ -197,6 +201,7 @@ procedure DispatchEnvelope(const Data: string); GEnvs[High(GEnvs)] := Data; N := Length(GEnvs); if Length(Data) > GMaxBody then GMaxBody := Length(Data); + Inc(GTotalBody, Length(Data)); H := GHandler; finally GLock.Release; @@ -446,7 +451,10 @@ function H_BuildSite(N: Integer; const EnvJSON: string): string; 1: Result := RoundOf([ OneCall('write_file', ArgsPathContent('bench-demo.html', '

bench

')), OneCall('todo_write', ArgsObj1('checklist', '- [x] write page'#10'- [ ] verify page'))]); - 2: Result := RoundOf([OneCall('read_file', ArgsPathPlain('bench-demo.html'))]); + 2: Result := RoundOf([OneCall('edit_file', + '{"path":"bench-demo.html","old_text":"

bench

","new_text":"

bench v2

"}')]); + else if N = 3 then + Result := RoundOf([OneCall('find_files', '{"pattern":"bench-*.html"}')]) else Result := StopOf('page written and verified.'); end; @@ -454,18 +462,41 @@ function H_BuildSite(N: Integer; const EnvJSON: string): string; procedure ScenarioBuildSite; var - Answer, SP2: string; + Answer, SP1, SP2: string; + S: TStringList; begin WriteLn; WriteLn('== scenario: build-site (goal anchor + ledger fold + deliverable) =='); + { B1 fixture: a recognisable project in the workspace -- the ## Project + facts (stack, make test, git branch) must reach iteration 1's system + prompt with zero exploration calls spent discovering them. } + S := TStringList.Create; + try + S.Text := 'all: build'#10#9'echo hi'#10'build:'#10#9'echo b'#10'test: build'#10#9'echo t'#10; + S.SaveToFile(GHomeDir + '/workspace/Makefile'); + finally + S.Free; + end; + ForceDirectories(GHomeDir + '/workspace/.git'); + S := TStringList.Create; + try + S.Text := 'ref: refs/heads/bench-main'#10; + S.SaveToFile(GHomeDir + '/workspace/.git/HEAD'); + finally + S.Free; + end; ResetScenario(H_BuildSite); Answer := Chat('[' + MsgObjJSON('user', 'build a small landing page named bench-demo.html for the demo project') + ']', 'bench-build'); - Check(EnvCount = 3, Format('loop finished in 3 provider calls (got %d)', [EnvCount])); - Check(not Has(EnvSystemPrompt(EnvAt(0)), '[progress ledger'), + Check(EnvCount = 4, Format('loop finished in 4 provider calls (got %d)', [EnvCount])); + SP1 := EnvSystemPrompt(EnvAt(0)); + Check(not Has(SP1, '[progress ledger'), 'iteration 1 system prompt is pristine (prefix-cache preserved)'); + Check(Has(SP1, '## Project'), 'project facts reach iteration 1'); + Check(Has(SP1, 'Test: make test'), 'facts name the verify command (make test)'); + Check(Has(SP1, 'Git branch: bench-main'), 'facts carry the git branch'); SP2 := EnvSystemPrompt(EnvAt(1)); Check(Has(SP2, '[progress ledger'), 'iteration 2 carries the progress ledger'); Check(Has(SP2, 'bench-demo.html'), 'ledger lists the written file'); @@ -474,6 +505,16 @@ procedure ScenarioBuildSite; Check(FileExists(GHomeDir + '/workspace/bench-demo.html'), 'deliverable exists in the workspace'); Check(Has(Answer, 'page written'), 'final answer surfaced'); + { B2: the edit's tool result carries the mini-diff snippet, so the model + verifies placement without a full-file re-read. } + Check(Has(EnvLastMessage(EnvAt(2)), 'now reads (lines'), + 'edit_file result carries the mini-diff context snippet'); + Check(Has(EnvLastMessage(EnvAt(2)), 'bench v2'), + 'snippet shows the changed content'); + { D1: one find_files call locates the deliverable by name -- no + list_dir ladder. } + Check(Has(EnvLastMessage(EnvAt(3)), 'bench-demo.html'), + 'find_files locates the file by glob in one call'); Metric('build-site.provider_calls', EnvCount); end; @@ -596,6 +637,169 @@ procedure ScenarioResumeAfterCap; Check(Has(Turn2, 'finished'), 'turn 2 delivered'); end; +function H_RepeatRead(N: Integer; const EnvJSON: string): string; +begin + if N <= 3 then + Result := RoundOf([OneCall('read_file', ArgsPathPlain('notes.txt'))]) + else + Result := StopOf('reviewed the notes.'); +end; + +procedure ScenarioRepeatRead; +{ C3: re-reading an unchanged file must not re-inject the full body -- + the second and third reads dedup to a one-line stub, so history growth + across the repeat reads is stub-sized, not file-sized. The 8 KB fixture + sits below the C1 cap on purpose: what keeps the bodies flat here is + the dedup, not the byte cap. } +var + S: TStringList; + Body: string; + i, Grow: Integer; +begin + WriteLn; + WriteLn('== scenario: repeat-read (per-turn dedup keeps history flat) =='); + Body := ''; + for i := 1 to 130 do + Body := Body + Format('note %3d: remember the thing about the thing', [i]) + #10; + S := TStringList.Create; + try + S.Text := Body; + S.SaveToFile(GHomeDir + '/workspace/notes.txt'); + finally + S.Free; + end; + + ResetScenario(H_RepeatRead); + Chat('[' + MsgObjJSON('user', + 'review notes.txt very carefully, twice if you must') + ']', 'bench-repeat'); + Check(EnvCount = 4, Format('four provider calls (got %d)', [EnvCount])); + Check(Has(EnvAt(2), 'unchanged since the earlier read'), + 'second read deduped to a stub in history'); + Grow := Length(EnvAt(3)) - Length(EnvAt(1)); + Check(Grow < 2500, + Format('history growth across 2 repeat reads is stub-sized (%d bytes; the file is ~7 KB)', [Grow])); + Metric('repeatread.growth_bytes_over_2_rereads', Grow); +end; + +function H_RealTask(N: Integer; const EnvJSON: string): string; +{ A deterministic POLICY, not a fixed script: the same code runs against + both binaries and adapts to what the harness offers -- exactly how a + real model reads its tool schemas. Where the after-binary provides + find_files / start_line / the mini-diff, the policy uses them; where + the before-binary doesn't, it falls back to the list_dir ladder and + full-file verify re-reads the original failing transcript showed. The + 60 KB "site dump" is generated locally (shell printf loop) instead of + a live fetch so the run is byte-deterministic -- it mirrors the real + transcript's fetch -> save -> parse loop. } +var + LastMsg: string; +begin + LastMsg := EnvLastMessage(EnvJSON); + case GStep of + 0: begin GStep := 1; + Result := RoundOf([OneCall('list_dir', ArgsObj1('path', '.'))]); end; + 1: begin GStep := 2; { "fetch the reference site" -> save a ~68 KB dump. + yes|head, not a shell loop: $((...)) trips the deny-substring + guard for command substitution. } + Result := RoundOf([OneCall('shell_exec', ArgsObj1('command', + 'yes "pasclaw dev site: tool-calling agent in object pascal, gateway, mcp, skills, sessions, memory pad" | head -800 > site-dump.html; wc -c site-dump.html'))]); end; + 2: begin GStep := 3; + Result := RoundOf([OneCall('read_file', ArgsPathPlain('site-dump.html'))]); end; + 3: begin GStep := 4; { "grab the README for feature listings" } + Result := RoundOf([OneCall('shell_exec', ArgsObj1('command', + 'yes "README feature line: agent loop, tools, sessions, gateway" | head -100 > readme-ref.md; wc -c readme-ref.md'))]); end; + 4: begin GStep := 5; + Result := RoundOf([OneCall('read_file', ArgsPathPlain('readme-ref.md'))]); end; + 5: begin GStep := 6; { "double-check the dump" -- the classic re-read } + Result := RoundOf([OneCall('read_file', ArgsPathPlain('site-dump.html'))]); end; + 6: begin GStep := 7; + Result := RoundOf([OneCall('write_file', ArgsPathContent('index.html', + ''#10'PasClaw'#10 + + ''#10'

PasClaw

'#10'

AI agent in Object Pascal.

'#10 + + ''))]); end; + 7: begin { locate the deliverable: glob if the harness has it } + if Pos('find_files', EnvJSON) > 0 then + begin + GStep := 9; + Result := RoundOf([OneCall('find_files', '{"pattern":"index.*"}')]); + end + else + begin + GStep := 8; + Result := RoundOf([OneCall('list_dir', ArgsObj1('path', '.'))]); + end; + end; + 8: begin GStep := 9; { ladder's second rung (no glob tool) } + Result := RoundOf([OneCall('list_dir', ArgsObj1('path', '.'))]); end; + 9: begin GStep := 10; { verify the write: surgical if ranges exist } + if Pos('start_line', EnvJSON) > 0 then + Result := RoundOf([OneCall('read_file', + '{"path":"index.html","start_line":1,"end_line":6}')]) + else + Result := RoundOf([OneCall('read_file', ArgsPathPlain('index.html'))]); + end; + 10: begin GStep := 11; + Result := RoundOf([OneCall('edit_file', + '{"path":"index.html","old_text":"PasClaw","new_text":"PasClaw v2 -- better than before"}')]); end; + 11: begin { trust the mini-diff; re-read blind edits } + if Pos('now reads', LastMsg) > 0 then + begin + GStep := 13; + Result := StopOf('done: index.html built in the workspace with the v2 title.'); + end + else + begin + GStep := 12; + Result := RoundOf([OneCall('read_file', ArgsPathPlain('index.html'))]); + end; + end; + else + Result := StopOf('done: index.html built in the workspace with the v2 title.'); + end; +end; + +procedure ScenarioRealTask; +{ The original failing prompt, end to end, under a policy model. } +var + Answer, Deliv: string; + S: TStringList; +begin + WriteLn; + WriteLn('== scenario: real-task (the pasclaw.dev build prompt, end to end) =='); + ResetScenario(H_RealTask); + Answer := Chat('[' + MsgObjJSON('user', + 'build a better version of https://pasclaw.dev/ -- ' + + 'https://github.com/fmxexpress/pasclaw/ if you need more feature ' + + 'listings. you can build it using HTML and HTMX if you need to or just ' + + 'vanilla javascript. it could be a single inline file or multiple ' + + 'files. make sure you use the workspace dir to do your work') + ']', + 'bench-realtask'); + + Deliv := ''; + if FileExists(GHomeDir + '/workspace/index.html') then + begin + S := TStringList.Create; + try + S.LoadFromFile(GHomeDir + '/workspace/index.html'); + Deliv := S.Text; + finally + S.Free; + end; + end; + { Guard against silently measuring the wrong task: the dump must have + been written and its body must have reached the model. } + Check(FileExists(GHomeDir + '/workspace/site-dump.html'), + 'the reference dump was written by the shell step'); + Check(Has(EnvAt(3), 'pasclaw dev site:'), + 'the dump body reached the model in the read result'); + Check(Deliv <> '', 'deliverable index.html exists in the workspace'); + Check(Has(Deliv, 'v2 -- better than before'), 'edit landed (v2 title)'); + Check(Has(Answer, 'done:'), 'turn finished with a final answer'); + Metric('realtask.provider_calls', EnvCount); + Metric('realtask.total_request_bytes', GTotalBody); + Metric('realtask.max_request_body_bytes', GMaxBody); +end; + { ---- gateway lifecycle ---------------------------------------------------- } var GW: TProcess; @@ -707,6 +911,8 @@ function WaitHealthy: Boolean; ScenarioMalformedRecovery; ScenarioResumeAfterCap; ScenarioFatRead; + ScenarioRepeatRead; + ScenarioRealTask; WriteLn; WriteLn('== metrics =='); diff --git a/src/pkg/agent/PasClaw.Agent.ProjectFacts.pas b/src/pkg/agent/PasClaw.Agent.ProjectFacts.pas new file mode 100644 index 0000000..4d7f420 --- /dev/null +++ b/src/pkg/agent/PasClaw.Agent.ProjectFacts.pas @@ -0,0 +1,272 @@ +(* + PasClaw.Agent.ProjectFacts -- deterministic "## Project" system-prompt + section: what stack is this, how do I build it, how do I test it, what + git branch am I on. + + Why: a coding agent dropped into a repo burns its first 5-10 tool calls + rediscovering facts the filesystem states outright (the observed + pasclaw.dev-build transcript opened with a wall of fs_list / probe + calls). Claude Code ships git state in every session env for the same + reason. With the commands in the prompt, Rule 3's "verify changes" can + point at THE actual command instead of hand-waving. + + Design constraints: + * PURE FILE READS -- no LLM call, no process exec. `pasclaw runbook` + does the LLM-authored deep version; this is the zero-cost floor + that works on every turn, offline, on both compilers (no TProcess). + Git branch comes from .git/HEAD; working-tree state is the model's + to query (`git status`) -- the block says so. + * BOUNDED -- small fixed probe list, first ~40 Makefile targets, one + package.json parse. Reading these per prompt build is microseconds. + * DEFERENT -- BuildSystemPrompt skips this section entirely when the + project has an AGENTS.md (the operator-authored doc wins; this is + the floor for repos that have nothing). +*) +unit PasClaw.Agent.ProjectFacts; + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} +{$H+} + +interface + +{ The "## Project" section for Dir, or '' when nothing recognisable is + there (an empty gateway workspace, a scratch dir). Dir is normally + CurrentWorkspace -- the directory relative tool paths resolve to. } +function BuildProjectFactsSection(const Dir: string): string; + +implementation + +uses + SysUtils, Classes, + PasClaw.JSON; + +function ReadSmallFile(const Path: string; MaxBytes: Integer): string; +var + FS: TFileStream; + Bytes: TBytes; + N: Integer; +begin + Result := ''; + if not FileExists(Path) then Exit; + try + FS := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite); + try + N := FS.Size; + if N > MaxBytes then N := MaxBytes; + SetLength(Bytes, N); + if N > 0 then FS.ReadBuffer(Bytes[0], N); + Result := TEncoding.UTF8.GetString(Bytes); + finally + FS.Free; + end; + except + Result := ''; + end; +end; + +function MakefileTargets(const Body: string; out HasTest, HasBuildish: Boolean): string; +{ First ~8 plain target names from a Makefile ("name:" at column 0, + skipping dot-targets, pattern rules and variable lines). Enough for the + model to see the vocabulary; the file itself is one read_file away. } +var + Lines: TStringList; + i, Shown: Integer; + L, Name: string; + P: Integer; +begin + Result := ''; + HasTest := False; + HasBuildish := False; + Shown := 0; + Lines := TStringList.Create; + try + Lines.Text := Body; + for i := 0 to Lines.Count - 1 do + begin + L := Lines[i]; + if (L = '') or (L[1] = #9) or (L[1] = ' ') or (L[1] = '.') or (L[1] = '#') then + Continue; + P := Pos(':', L); + if P < 2 then Continue; + { Variable assignments, not rules: "CC := gcc" (the '=' follows the + colon) and "CC=..." with an embedded colon later. } + if (P < Length(L)) and (L[P + 1] = '=') then Continue; + if Pos('=', Copy(L, 1, P)) > 0 then Continue; + Name := Trim(Copy(L, 1, P - 1)); + if (Name = '') or (Pos(' ', Name) > 0) or (Pos('%', Name) > 0) + or (Pos('$', Name) > 0) then Continue; + if SameText(Name, 'test') or (Pos('test', LowerCase(Name)) = 1) then + HasTest := True; + if SameText(Name, 'all') or SameText(Name, 'build') then + HasBuildish := True; + if Shown < 8 then + begin + if Result <> '' then Result := Result + ', '; + Result := Result + Name; + Inc(Shown); + end; + end; + finally + Lines.Free; + end; +end; + +function PackageJsonScripts(const Body: string): string; +{ "name: command" lines for up to 6 package.json scripts, build/test/ + start/dev first. } +const + Preferred: array[0..3] of string = ('build', 'test', 'start', 'dev'); +var + Root, Scripts: TJsonObject; + i, Shown: Integer; + K, V: string; +begin + Result := ''; + Root := nil; + try + Root := TJsonObject.Parse(Body); + except + Root := nil; + end; + if Root = nil then Exit; + try + Scripts := Root.ChildObject('scripts'); + if Scripts = nil then Exit; + try + Shown := 0; + for i := 0 to High(Preferred) do + begin + V := Scripts.GetStr(Preferred[i], ''); + if V = '' then Continue; + K := 'npm run ' + Preferred[i]; + if Preferred[i] = 'test' then K := 'npm test'; + if Result <> '' then Result := Result + '; '; + Result := Result + K; + Inc(Shown); + if Shown >= 6 then Break; + end; + finally + Scripts.Free; + end; + finally + Root.Free; + end; +end; + +function GitBranch(const Dir: string): string; +{ Branch name from .git/HEAD ("ref: refs/heads/"); a detached + HEAD (bare hash) is reported as such. Pure read -- working-tree state + is deliberately NOT computed here (that would need exec); the section + tells the model to run `git status` itself. } +var + Head: string; +begin + Result := ''; + Head := Trim(ReadSmallFile(Dir + PathDelim + '.git' + PathDelim + 'HEAD', 512)); + if Head = '' then Exit; + if Copy(Head, 1, 16) = 'ref: refs/heads/' then + Result := Copy(Head, 17, MaxInt) + else + Result := '(detached: ' + Copy(Head, 1, 12) + ')'; +end; + +function HasAny(const Dir: string; const Names: array of string): Boolean; +var + i: Integer; +begin + Result := False; + for i := 0 to High(Names) do + if FileExists(Dir + PathDelim + Names[i]) then Exit(True); +end; + +function HasExt(const Dir, Ext: string): Boolean; +var + SR: TSearchRec; +begin + Result := FindFirst(Dir + PathDelim + '*' + Ext, faAnyFile, SR) = 0; + FindClose(SR); +end; + +function BuildProjectFactsSection(const Dir: string): string; +var + Stack, BuildCmd, TestCmd, Targets, Scripts, Branch: string; + MkBody: string; + HasTest, HasBuildish: Boolean; + + procedure AddStack(const S: string); + begin + if Stack <> '' then Stack := Stack + ', '; + Stack := Stack + S; + end; + +begin + Result := ''; + if (Dir = '') or (not DirectoryExists(Dir)) then Exit; + Stack := ''; BuildCmd := ''; TestCmd := ''; Targets := ''; Scripts := ''; + + MkBody := ReadSmallFile(Dir + PathDelim + 'Makefile', 128 * 1024); + if MkBody <> '' then + begin + AddStack('Makefile'); + Targets := MakefileTargets(MkBody, HasTest, HasBuildish); + if BuildCmd = '' then BuildCmd := 'make'; + if HasTest then TestCmd := 'make test'; + end; + + if FileExists(Dir + PathDelim + 'package.json') then + begin + AddStack('Node (package.json)'); + Scripts := PackageJsonScripts(ReadSmallFile(Dir + PathDelim + 'package.json', 64 * 1024)); + if (BuildCmd = '') and (Pos('npm run build', Scripts) > 0) then BuildCmd := 'npm run build'; + if (TestCmd = '') and (Pos('npm test', Scripts) > 0) then TestCmd := 'npm test'; + end; + + if FileExists(Dir + PathDelim + 'Cargo.toml') then + begin + AddStack('Rust (Cargo.toml)'); + if BuildCmd = '' then BuildCmd := 'cargo build'; + if TestCmd = '' then TestCmd := 'cargo test'; + end; + + if FileExists(Dir + PathDelim + 'go.mod') then + begin + AddStack('Go (go.mod)'); + if BuildCmd = '' then BuildCmd := 'go build ./...'; + if TestCmd = '' then TestCmd := 'go test ./...'; + end; + + if HasExt(Dir, '.dpr') or HasExt(Dir, '.lpi') then + AddStack('Pascal (FPC/Delphi project)'); + + if HasAny(Dir, ['pyproject.toml', 'requirements.txt']) then + begin + AddStack('Python'); + if (TestCmd = '') and (HasAny(Dir, ['pytest.ini']) or + DirectoryExists(Dir + PathDelim + 'tests')) then + TestCmd := 'pytest'; + end; + + Branch := GitBranch(Dir); + + { Nothing recognisable -> no section (an empty workspace stays quiet). } + if (Stack = '') and (Branch = '') then Exit; + + Result := '## Project' + sLineBreak; + if Stack <> '' then + Result := Result + 'Stack: ' + Stack + sLineBreak; + if BuildCmd <> '' then + Result := Result + 'Build: ' + BuildCmd + sLineBreak; + if TestCmd <> '' then + Result := Result + 'Test: ' + TestCmd + + ' <- run this to verify after code edits' + sLineBreak; + if Targets <> '' then + Result := Result + 'Make targets: ' + Targets + sLineBreak; + if Scripts <> '' then + Result := Result + 'npm scripts: ' + Scripts + sLineBreak; + if Branch <> '' then + Result := Result + 'Git branch: ' + Branch + + ' (run `git status` for working-tree state)' + sLineBreak; + Result := TrimRight(Result); +end; + +end. diff --git a/src/pkg/agent/PasClaw.Agent.Prompt.pas b/src/pkg/agent/PasClaw.Agent.Prompt.pas index 6ea22c0..f657dc1 100644 --- a/src/pkg/agent/PasClaw.Agent.Prompt.pas +++ b/src/pkg/agent/PasClaw.Agent.Prompt.pas @@ -178,6 +178,7 @@ implementation PasClaw.Agent.Orient, { task-aware MEMORY slicing (Cfg.OrientTaskAware) } PasClaw.Memory.Facts, { distilled-fact injection (Cfg.MemoryDistillEnabled) } PasClaw.Tools.Sandbox, { CurrentWorkspace -- the working dir the prompt advertises } + PasClaw.Agent.ProjectFacts, { deterministic ## Project section (stack/build/test/git) } PasClaw.MCP.Disclosure; { deferred-tools section (Cfg.MCPProgressiveDisclosure) } const @@ -238,6 +239,14 @@ function BuildIdentitySection: string; RuntimeString; end; +function PromptWorkDir: string; +{ The directory relative tool paths resolve to -- the same value the + Workspace section advertises (configured workspace, or launch dir). } +begin + Result := CurrentWorkspace; + if Trim(Result) = '' then Result := GetCurrentDir; +end; + function BuildWorkspaceSection: string; var Home, WorkDir: string; @@ -846,6 +855,19 @@ function BuildSystemPrompt(Cfg: TConfig; const UserSys: string; Result := AppendSection(Result, BuildPlanModeSection); Result := AppendSection(Result, BuildIdentitySection); Result := AppendSection(Result, BuildWorkspaceSection); + { Deterministic project facts (stack / build / test commands / git + branch) detected from the working directory by pure file reads -- + saves the model its usual "what kind of repo is this" exploration + prefix and gives Rule 3's verify-your-changes a concrete command. + Skipped when the project carries an AGENTS.md: the operator-authored + doc (emitted below as Project Rules) states this better; facts are + the zero-config floor. } + { The AGENTS.md check must walk the SAME tree the facts are read from + (the workspace) -- with '' it walked the launch cwd, so a workspace + AGENTS.md failed to suppress the facts and an unrelated launch-dir + AGENTS.md could suppress useful workspace facts. } + if FindProjectAgentsMd(PromptWorkDir) = '' then + Result := AppendSection(Result, BuildProjectFactsSection(PromptWorkDir)); Result := AppendSection(Result, BuildMemorySection((Cfg <> nil) and Cfg.OrientTaskAware, TaskHint)); { Distilled facts (Cfg.MemoryDistillEnabled). Wholesale, after the .md diff --git a/src/pkg/tools/PasClaw.Tools.FS.pas b/src/pkg/tools/PasClaw.Tools.FS.pas index 1e1ae3a..a85e843 100644 --- a/src/pkg/tools/PasClaw.Tools.FS.pas +++ b/src/pkg/tools/PasClaw.Tools.FS.pas @@ -190,6 +190,8 @@ function Tool_FSRead(const ArgsJSON: string; out ErrMsg: string): string; var Path, Body, Reason: string; Hashline: Boolean; + StartLn, EndLn, Total, i: Integer; + Lines: TStringList; begin ErrMsg := ''; if not ParseStringArg(ArgsJSON, 'path', Path) then @@ -209,6 +211,39 @@ function Tool_FSRead(const ArgsJSON: string; out ErrMsg: string): string; Exit(''); end; Body := ReadFileText(Path); + { Optional line range (C2): a grep_files hit gives the line number; the + follow-up read can be surgical instead of swallowing the whole file + into history. 1-based inclusive; bounds are clamped; range implies + plain output (hashline headers hash the WHOLE file, so a sliced body + must not carry one). } + StartLn := Integer(ParseInt64Arg(ArgsJSON, 'start_line', 0)); + EndLn := Integer(ParseInt64Arg(ArgsJSON, 'end_line', 0)); + if (StartLn > 0) or (EndLn > 0) then + begin + Lines := TStringList.Create; + try + Lines.LineBreak := #10; + Lines.StrictDelimiter := True; + Lines.Text := StringReplace(Body, #13, '', [rfReplaceAll]); + Total := Lines.Count; + { Empty file: the clamps below would drive StartLn to 0 and the + slice loop into Lines[-1] (range-check error). Say it plainly. } + if Total = 0 then Exit('(empty file: 0 lines)'); + if StartLn < 1 then StartLn := 1; + if (EndLn < 1) or (EndLn > Total) then EndLn := Total; + if StartLn > Total then StartLn := Total; + if EndLn < StartLn then EndLn := StartLn; + Body := ''; + for i := StartLn to EndLn do + begin + if Body <> '' then Body := Body + #10; + Body := Body + Lines[i - 1]; + end; + Exit(Format('(lines %d-%d of %d)', [StartLn, EndLn, Total]) + #10 + Body); + finally + Lines.Free; + end; + end; { Plain text is the default -- clean content is what edit_file's old_text/new_text string replacement matches against, and it's what smaller models handle best. The hashline #hash + LINENO:line format is @@ -1096,6 +1131,98 @@ function Tool_FSApplyPatch(const ArgsJSON: string; out ErrMsg: string): string; Result := Format('applied patch: %d added, %d updated, %d deleted', [nAdd, nUpd, nDel]); end; +function Tool_FSFindFiles(const ArgsJSON: string; out ErrMsg: string): string; +{ find_files -- locate files by NAME with a glob, the question grep_files + (contents) and list_dir (one level) can't answer without either a + known-content guess or a directory-by-directory descent -- the exact + fs_list ladder observed in real transcripts. Reuses grep_files' walk + discipline: skip dotdirs and the well-known build/VCS/deps dirs, cap + the result list. Matches the Glob/Grep tool pair every mature harness + ships, so the model's priors already expect it. } +const + DefaultMax = 100; + HardMax = 500; +var + Root, Pattern, Reason, Rel: string; + MaxResults, Found: Integer; + Hits: TStringList; + + procedure Walk(const Dir: string); + var + SR: TSearchRec; + begin + if Found > MaxResults then Exit; + if FindFirst(Dir + PathDelim + '*', faAnyFile, SR) = 0 then + try + repeat + if (SR.Name = '.') or (SR.Name = '..') then Continue; + if (SR.Attr and faDirectory) <> 0 then + begin + if (SR.Name <> '') and (SR.Name[1] = '.') then Continue; + if IsBlockedGrepDir(SR.Name) then Continue; + Walk(Dir + PathDelim + SR.Name); + end + else if MatchesMask(SR.Name, Pattern) then + begin + Inc(Found); + if Found <= MaxResults then + begin + Rel := Dir + PathDelim + SR.Name; + if Copy(Rel, 1, Length(Root) + 1) = Root + PathDelim then + Delete(Rel, 1, Length(Root) + 1); + Hits.Add(Rel); + end; + end; + if Found > MaxResults then Break; + until FindNext(SR) <> 0; + finally + FindClose(SR); + end; + end; + +begin + ErrMsg := ''; + Result := ''; + if not ParseStringArg(ArgsJSON, 'pattern', Pattern) then + begin + ErrMsg := 'missing required argument: pattern (a filename glob, e.g. "*.pas" or "webui.*")'; + Exit(''); + end; + if not ParseStringArg(ArgsJSON, 'path', Root) then Root := '.'; + Root := ResolveWorkspacePath(Root); + if not CanReadPath(Root, Reason) then + begin + ErrMsg := Reason; + Exit(''); + end; + if not DirectoryExists(Root) then + begin + ErrMsg := 'no such directory: ' + Root; + Exit(''); + end; + Root := ExcludeTrailingPathDelimiter(Root); + MaxResults := Integer(ParseInt64Arg(ArgsJSON, 'max_results', DefaultMax)); + if MaxResults < 1 then MaxResults := 1; + if MaxResults > HardMax then MaxResults := HardMax; + + Found := 0; + Hits := TStringList.Create; + try + Walk(Root); + Hits.Sort; + if Hits.Count = 0 then + Exit(Format('no files matching "%s" under %s (names only -- use grep_files to search contents)', + [Pattern, Root])); + Result := Format('%d file(s) matching "%s" under %s:', [Hits.Count, Pattern, Root]) + + #10 + TrimRight(Hits.Text); + if Found > MaxResults then + Result := Result + #10 + Format('... (more matches beyond the %d-result cap; narrow the pattern or path)', + [MaxResults]); + finally + Hits.Free; + end; +end; + function Tool_FSAppend(const ArgsJSON: string; out ErrMsg: string): string; { append_file: add content to the end of a file (creating it + parent dirs when absent). The incremental-write escape hatch -- build a large file @@ -1157,6 +1284,55 @@ function CountSubstr(const S, Sub: string): Integer; until False; end; +function EditContextSnippet(const NewContent: string; + FirstChangeOfs, NewTextLen: Integer): string; +{ Mini-diff feedback: the changed region of the NEW file body with +-3 + context lines and line numbers, so the model can confirm the edit + landed where intended WITHOUT a follow-up full-file read_file (which + re-injects the whole body into history). FirstChangeOfs is the 1-based + char offset where the replacement begins. Bounded to 12 lines. } +const + CtxLines = 3; + MaxLines = 12; +var + Lines: TStringList; + i, FirstLine, LastLine, Lo, Hi, Shown: Integer; +begin + Result := ''; + { 1-based line of the change start = newlines before it + 1. } + FirstLine := 1; + for i := 1 to FirstChangeOfs - 1 do + if (i <= Length(NewContent)) and (NewContent[i] = #10) then Inc(FirstLine); + LastLine := FirstLine; + for i := FirstChangeOfs to FirstChangeOfs + NewTextLen - 1 do + if (i >= 1) and (i <= Length(NewContent)) and (NewContent[i] = #10) then Inc(LastLine); + + Lines := TStringList.Create; + try + Lines.LineBreak := #10; + Lines.StrictDelimiter := True; + Lines.Text := StringReplace(NewContent, #13, '', [rfReplaceAll]); + Lo := FirstLine - CtxLines; if Lo < 1 then Lo := 1; + Hi := LastLine + CtxLines; if Hi > Lines.Count then Hi := Lines.Count; + Shown := 0; + for i := Lo to Hi do + begin + if Shown >= MaxLines then + begin + Result := Result + Format(' ... (%d more line(s))', [Hi - i + 1]) + #10; + Break; + end; + Result := Result + Format('%6d: %s', [i, Lines[i - 1]]) + #10; + Inc(Shown); + end; + Result := TrimRight(Result); + if Result <> '' then + Result := Format('now reads (lines %d-%d):', [Lo, Hi]) + #10 + Result; + finally + Lines.Free; + end; +end; + function Tool_FSEdit(const ArgsJSON: string; out ErrMsg: string): string; { edit_file: two modes. 1. Plain string replacement (default): old_text -> new_text, the form @@ -1168,7 +1344,7 @@ function Tool_FSEdit(const ArgsJSON: string; out ErrMsg: string): string; var Path, OldText, NewText, Content, Reason: string; ReplaceAll: Boolean; - Cnt: Integer; + Cnt, FirstOfs: Integer; begin ErrMsg := ''; { Hashline mode wins when a patch is supplied. } @@ -1223,6 +1399,7 @@ function Tool_FSEdit(const ArgsJSON: string; out ErrMsg: string): string; [Cnt, Path]); Exit(''); end; + FirstOfs := Pos(OldText, Content); { where the (first) change lands } if ReplaceAll then Content := StringReplace(Content, OldText, NewText, [rfReplaceAll]) else @@ -1230,7 +1407,8 @@ function Tool_FSEdit(const ArgsJSON: string; out ErrMsg: string): string; try SnapshotBeforeWrite(Path); WriteFileText(Path, Content); - Result := Format('edited %s (replaced %d occurrence(s))', [Path, Cnt]); + Result := Format('edited %s (replaced %d occurrence(s))', [Path, Cnt]) + #10 + + EditContextSnippet(Content, FirstOfs, Length(NewText)); except on E: Exception do begin @@ -1297,12 +1475,17 @@ procedure RegisterFSTools(R: TToolRegistry; UseHashline: Boolean); 'Pass {"hashline":true} for the ' + HL_FILE_PREFIX + 'path#hash header + LINENO:line format used to build an ' + 'edit_file `patch` (advanced).'; - T.Schema := '{"type":"object","properties":{"path":{"type":"string"},"hashline":{"type":"boolean","description":"Return the hashline #hash+LINENO format for edit_file patch edits, instead of plain text."}},"required":["path"]}'; + T.Schema := '{"type":"object","properties":{"path":{"type":"string"},' + + '"start_line":{"type":"integer","minimum":1,"description":"First line to return (1-based). Use with end_line to read just the region a grep_files hit pointed at."},' + + '"end_line":{"type":"integer","minimum":1,"description":"Last line to return (inclusive; clamped to the file end)."},' + + '"hashline":{"type":"boolean","description":"Return the hashline #hash+LINENO format for edit_file patch edits, instead of plain text. Ignored when a line range is set."}},"required":["path"]}'; end else begin T.Description := 'Read the contents of a file from the local filesystem.'; - T.Schema := '{"type":"object","properties":{"path":{"type":"string","description":"Absolute or relative path to the file."}},"required":["path"]}'; + T.Schema := '{"type":"object","properties":{"path":{"type":"string","description":"Absolute or relative path to the file."},' + + '"start_line":{"type":"integer","minimum":1,"description":"First line to return (1-based)."},' + + '"end_line":{"type":"integer","minimum":1,"description":"Last line to return (inclusive; clamped)."}},"required":["path"]}'; end; T.Handler := Tool_FSRead; T.IsCore := True; @@ -1369,6 +1552,25 @@ procedure RegisterFSTools(R: TToolRegistry; UseHashline: Boolean); T.Category := tcReadOnly; Emit('fs_grep'); + { find_files (new) -- locate files by NAME; the Glob half of the + Glob/Grep pair. } + T := Default(TTool); + T.Name := 'find_files'; + T.Description := 'Find files by NAME with a glob pattern (e.g. "*.pas", "webui.*", ' + + '"Makefile"). Searches recursively from path (default: the working ' + + 'directory), skipping VCS/build/deps dirs, and returns matching paths ' + + 'one per line. Use this to locate a file before reading it; use ' + + 'grep_files to search file CONTENTS instead.'; + T.Schema := '{"type":"object","properties":{' + + '"pattern":{"type":"string","description":"Filename glob: * and ? wildcards, matched against the file NAME."},' + + '"path":{"type":"string","description":"Directory to search from (default: the working directory)."},' + + '"max_results":{"type":"integer","minimum":1,"maximum":500,"description":"Cap on returned paths (default 100)."}' + + '},"required":["pattern"]}'; + T.Handler := Tool_FSFindFiles; + T.IsCore := True; + T.Category := tcReadOnly; + R.Register(T); + { edit_file (was fs_edit_hashline) -- now registered UNCONDITIONALLY. The default old_text->new_text string-replacement mode works for every model; the hashline `patch` mode is advanced and only advertised (in diff --git a/src/pkg/tools/PasClaw.Tools.ToolLoop.pas b/src/pkg/tools/PasClaw.Tools.ToolLoop.pas index ad4a123..0dfbd8a 100644 --- a/src/pkg/tools/PasClaw.Tools.ToolLoop.pas +++ b/src/pkg/tools/PasClaw.Tools.ToolLoop.pas @@ -1042,6 +1042,41 @@ procedure LedgerHarvest(var L: TProgressLedger; end; end; +procedure DedupRepeatRead(var Paths, Hashes: TArray; + const Nm, Args: string; var Body: string; + const Err: string); +{ Per-turn read dedup (C3): a model that re-reads an unchanged file "to be + safe" re-injects the full body into history every time (a constant in + observed transcripts). When THIS loop already returned a byte-identical + body for the same path, swap the repeat for a one-line stub pointing at + the earlier result. Scoped to one RunToolLoop call -- the state lives in + the loop's own locals, so concurrent sessions / subagents can't cross- + talk, and a file that CHANGED between reads hashes differently and passes + through untouched. } +var + i: Integer; + P, H: string; +begin + if (Err <> '') or ((Nm <> 'read_file') and (Nm <> 'fs_read')) then Exit; + P := LedgerArg(Args, 'path'); + if P = '' then Exit; + H := ComputeFileHash(Body); + for i := 0 to High(Paths) do + if Paths[i] = P then + begin + if Hashes[i] = H then + Body := Format('read_file %s: unchanged since the earlier read this ' + + 'turn (hash #%s) -- the previous read_file result above ' + + 'is still current; do not re-read it again.', [P, H]); + Hashes[i] := H; + Exit; + end; + SetLength(Paths, Length(Paths) + 1); + SetLength(Hashes, Length(Hashes) + 1); + Paths[High(Paths)] := P; + Hashes[High(Hashes)] := H; +end; + function LedgerJoin(const A: TArray; const Sep: string): string; var i: Integer; @@ -1135,6 +1170,7 @@ function RunToolLoop(const Cfg: TToolLoopConfig; Steering, BatchSteering, HistSystem, LastProviderErrText, BgBlock, PersistentSP: string; Ledger: TProgressLedger; LedgerBlock: string; + ReadPaths, ReadHashes: TArray; { per-turn read-dedup state (C3) } Steers: TSteeringMessageArray; InContext: string; { tool output cap (#PR new): in-context body that lands in Hist after the @@ -1198,6 +1234,8 @@ function RunToolLoop(const Cfg: TToolLoopConfig; Ledger := Default(TProgressLedger); if not Cfg.DisableProgressLedger then Ledger.Goal := ExtractLoopGoal(Messages); + SetLength(ReadPaths, 0); + SetLength(ReadHashes, 0); Iter := 0; { When progressive disclosure is on (PasClaw.MCP.Disclosure), the @@ -1706,6 +1744,14 @@ function RunToolLoop(const Cfg: TToolLoopConfig; Dispatches[Batch[j]].ResultText); end; + { Per-turn read dedup (C3) -- before promptware/cap so the tiny + stub skips both. } + DedupRepeatRead(ReadPaths, ReadHashes, + Dispatches[Batch[j]].Call.Func.Name, + Dispatches[Batch[j]].Call.Func.Arguments, + Dispatches[Batch[j]].ResultText, + Dispatches[Batch[j]].Err); + { Promptware chokepoint 1 of 3: tool output is the widest door for indirect prompt injection (fetched pages, read files, MCP responses). A pattern hit prepends a warning diff --git a/src/tests/fs_tool_naming_tests.pas b/src/tests/fs_tool_naming_tests.pas index 981363d..67e9765 100644 --- a/src/tests/fs_tool_naming_tests.pas +++ b/src/tests/fs_tool_naming_tests.pas @@ -148,6 +148,24 @@ function ReadBack(Reg: TToolRegistry; const Path: string): string; AssertContains(R, '1:hello', 'read_file hashline:true emits LINENO:line'); WriteLn(' ok: read_file plain by default, hashline:true opts in'); + { --- 2c. read_file line ranges (C2). --- } + Reg.RunTool('write_file', '{"path":"' + PathA + '","content":"r1\nr2\nr3\nr4\nr5"}', Err); + R := Reg.RunTool('read_file', '{"path":"' + PathA + '","start_line":2,"end_line":3}', Err); + AssertContains(R, '(lines 2-3 of 5)', 'range read reports the slice + total'); + AssertContains(R, 'r2', 'range includes start line'); + AssertContains(R, 'r3', 'range includes end line'); + AssertTrue(Pos('r4', R) = 0, 'range excludes lines past end_line'); + R := Reg.RunTool('read_file', '{"path":"' + PathA + '","start_line":4,"end_line":99}', Err); + AssertContains(R, '(lines 4-5 of 5)', 'end_line clamps to the file end'); + { empty file + range: must not range-check into Lines[-1] } + Reg.RunTool('write_file', '{"path":"' + PathA + '","content":""}', Err); + R := Reg.RunTool('read_file', '{"path":"' + PathA + '","start_line":1,"end_line":5}', Err); + AssertEqStr(Err, '', 'range read of an empty file is not an error'); + AssertContains(R, '(empty file', 'empty file reports itself instead of crashing'); + WriteLn(' ok: read_file start_line/end_line slices and clamps'); + { restore the fixture the append section below builds on } + Reg.RunTool('write_file', '{"path":"' + PathA + '","content":"hello"}', Err); + { --- 3. append_file concatenates. --- } R := Reg.RunTool('append_file', '{"path":"' + PathA + '","content":" world"}', Err); AssertEqStr(Err, '', 'append_file no error'); @@ -179,12 +197,40 @@ function ReadBack(Reg: TToolRegistry; const Path: string): string; AssertEqStr(Err, '', 'edit_file replace_all no error'); AssertEqStr(ReadBack(Reg, PathA), 'y y y', 'edit_file replaced all occurrences'); + { mini-diff feedback: the result shows the changed region with line + numbers and +-3 context so the model needn't re-read the file. } + Reg.RunTool('write_file', '{"path":"' + PathA + '","content":"l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8"}', Err); + R := Reg.RunTool('edit_file', '{"path":"' + PathA + '","old_text":"l5","new_text":"L5-CHANGED"}', Err); + AssertContains(R, 'now reads (lines 2-8):', 'snippet header with clamped range'); + AssertContains(R, '5: L5-CHANGED', 'snippet shows the changed line with its number'); + AssertContains(R, '2: l2', 'snippet includes leading context'); + AssertContains(R, '8: l8', 'snippet includes trailing context'); + AssertTrue(Pos('1: l1', R) = 0, 'context is bounded (line 1 outside +-3)'); + { delete (omit new_text) } Reg.RunTool('write_file', '{"path":"' + PathA + '","content":"keepDROPkeep"}', Err); Reg.RunTool('edit_file', '{"path":"' + PathA + '","old_text":"DROP"}', Err); AssertEqStr(ReadBack(Reg, PathA), 'keepkeep', 'edit_file deletes when new_text omitted'); WriteLn(' ok: edit_file str-replace (unique / not-found / ambiguous / replace_all / delete)'); + { --- 4b. find_files: glob by NAME (D1). --- } + AssertTrue(DefsHasName(Reg.ToProviderDefs, 'find_files'), 'find_files advertised'); + ForceDirectories(Dir + PathDelim + 'sub'); + ForceDirectories(Dir + PathDelim + 'node_modules'); + Reg.RunTool('write_file', '{"path":"' + JEsc(Dir + PathDelim + 'sub' + PathDelim + 'deep.pas') + '","content":"x"}', Err); + Reg.RunTool('write_file', '{"path":"' + JEsc(Dir + PathDelim + 'top.pas') + '","content":"x"}', Err); + Reg.RunTool('write_file', '{"path":"' + JEsc(Dir + PathDelim + 'node_modules' + PathDelim + 'skip.pas') + '","content":"x"}', Err); + R := Reg.RunTool('find_files', '{"pattern":"*.pas","path":"' + JEsc(Dir) + '"}', Err); + AssertEqStr(Err, '', 'find_files no error'); + AssertContains(R, '2 file(s) matching', 'finds both .pas files'); + AssertContains(R, 'top.pas', 'top-level match listed'); + AssertContains(R, 'deep.pas', 'recursive match listed (relative path)'); + AssertTrue(Pos('skip.pas', R) = 0, 'node_modules is skipped'); + R := Reg.RunTool('find_files', '{"pattern":"nosuch.*","path":"' + JEsc(Dir) + '"}', Err); + AssertContains(R, 'no files matching', 'empty result explains itself'); + AssertContains(R, 'grep_files', 'empty result points at the contents-search sibling'); + WriteLn(' ok: find_files globs by name, skips deps dirs'); + { --- 5. apply_patch: multi-file (update + add + delete) in one call. --- } AssertTrue(DefsHasName(Reg.ToProviderDefs, 'apply_patch'), 'apply_patch advertised'); PathC := JoinPath(Dir, 'c.txt'); diff --git a/src/tests/progress_ledger_tests.pas b/src/tests/progress_ledger_tests.pas index 1859722..950b7b6 100644 --- a/src/tests/progress_ledger_tests.pas +++ b/src/tests/progress_ledger_tests.pas @@ -320,6 +320,46 @@ procedure TestGoalSkipsMicroTurns; end; end; +procedure TestRepeatReadDedup; +{ C3: a second identical read of the same unchanged file within one loop + is swapped for a one-line stub; a range read (different body) is not. } +var + P: TScripted; + Reg: TToolRegistry; + Cfg: TToolLoopConfig; + Msgs: TMessageArray; + Loop: TToolLoopResult; + i, Full, Stub: Integer; +begin + Reg := TToolRegistry.Create; + try + RegisterFSTools(Reg, True); + P := TScripted.Create; + Cfg := BaseCfg(P); + Cfg.Registry := Reg; + P.AddToolRound([MkCall('write_file', '{"path":"' + FileA + '","content":"same body here"}')]); + P.AddToolRound([MkCall('read_file', '{"path":"' + FileA + '","plain":true}')]); + P.AddToolRound([MkCall('read_file', '{"path":"' + FileA + '","plain":true}')]); + P.AddStop('done'); + + SetLength(Msgs, 1); + Msgs[0] := MakeMessage(mrUser, 'read the file twice for no reason at all'); + AssertTrue(RunToolLoop(Cfg, Msgs, Loop), 'loop ran'); + Full := 0; Stub := 0; + for i := 0 to High(Loop.FinalMessages) do + if Loop.FinalMessages[i].Role = mrTool then + begin + if Pos('same body here', Loop.FinalMessages[i].Content) > 0 then Inc(Full); + if Pos('unchanged since the earlier read', Loop.FinalMessages[i].Content) > 0 then Inc(Stub); + end; + AssertTrue(Full = 1, Format('exactly one full body in history (got %d)', [Full])); + AssertTrue(Stub = 1, Format('the repeat read became a stub (got %d)', [Stub])); + WriteLn(' ok: repeat read of an unchanged file dedups to a stub'); + finally + Reg.Free; + end; +end; + procedure TestDisableSwitch; var P: TScripted; @@ -366,6 +406,7 @@ procedure TestDisableSwitch; TestNudgeAfterReadOnlyCalls; TestMaxIterSummaryAndNotice; TestGoalSkipsMicroTurns; + TestRepeatReadDedup; TestDisableSwitch; if FileExists(FileA) then DeleteFile(FileA); diff --git a/src/tests/project_facts_tests.pas b/src/tests/project_facts_tests.pas new file mode 100644 index 0000000..5c2b3e1 --- /dev/null +++ b/src/tests/project_facts_tests.pas @@ -0,0 +1,135 @@ +program project_facts_tests; +(* + Covers PasClaw.Agent.ProjectFacts -- the deterministic "## Project" + system-prompt section (stack / build / test commands / git branch from + pure file reads). Pins: + * Makefile detection: target names surface, `make` as build, a test + target promotes `make test` as THE verify command. + * package.json scripts surface (npm run build / npm test). + * Cargo.toml / go.mod fill build/test only when nothing better claimed + them (Makefile wins). + * Git branch parsed from .git/HEAD; detached HEAD reported as such. + * An empty / unrecognisable directory yields NO section. +*) + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} +{$H+} +{$IFDEF FPC}{$CODEPAGE UTF8}{$ENDIF} + +uses + {$IFDEF UNIX}cthreads,{$ENDIF} + SysUtils, Classes, + PasClaw.Agent.ProjectFacts; + +procedure Fail_(const Msg: string); +begin WriteLn('FAIL: ' + Msg); Halt(1); end; + +procedure AssertTrue(Cond: Boolean; const Msg: string); +begin if not Cond then Fail_(Msg); end; + +procedure AssertHas(const Hay, Needle, Msg: string); +begin + if Pos(Needle, Hay) <= 0 then + Fail_(Msg + ' (needle "' + Needle + '" missing from "' + Copy(Hay, 1, 300) + '")'); +end; + +procedure AssertNot(const Hay, Needle, Msg: string); +begin + if Pos(Needle, Hay) > 0 then + Fail_(Msg + ' (unexpected "' + Needle + '")'); +end; + +procedure WriteText(const Path, Body: string); +var + S: TStringList; +begin + S := TStringList.Create; + try + S.Text := Body; + S.SaveToFile(Path); + finally + S.Free; + end; +end; + +procedure Nuke(const Dir: string); +var + SR: TSearchRec; +begin + if FindFirst(Dir + '/*', faAnyFile, SR) = 0 then + begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + if (SR.Attr and faDirectory) <> 0 then Nuke(Dir + '/' + SR.Name) + else DeleteFile(Dir + '/' + SR.Name); + end; + until FindNext(SR) <> 0; + FindClose(SR); + end; + RemoveDir(Dir); +end; + +var + Dir, S: string; +begin + Dir := IncludeTrailingPathDelimiter(GetTempDir) + 'pcfacts'; + if DirectoryExists(Dir) then Nuke(Dir); + ForceDirectories(Dir); + + { Empty dir -> no section. } + AssertTrue(BuildProjectFactsSection(Dir) = '', 'empty dir yields no section'); + AssertTrue(BuildProjectFactsSection('') = '', 'blank dir yields no section'); + + { Makefile with test target + git branch. } + WriteText(Dir + '/Makefile', + 'CC := gcc'#10 + + 'all: build'#10#9'echo hi'#10 + + 'build:'#10#9'echo build'#10 + + 'test: build'#10#9'echo test'#10 + + '.PHONY: all'#10 + + '%.o: %.c'#10#9'cc'#10); + ForceDirectories(Dir + '/.git'); + WriteText(Dir + '/.git/HEAD', 'ref: refs/heads/feature/x'#10); + S := BuildProjectFactsSection(Dir); + AssertHas(S, '## Project', 'section header'); + AssertHas(S, 'Makefile', 'stack names Makefile'); + AssertHas(S, 'Build: make', 'build command is make'); + AssertHas(S, 'Test: make test', 'test target promotes make test'); + AssertHas(S, 'verify after code edits', 'test line carries the verify nudge'); + AssertHas(S, 'all, build, test', 'target names listed'); + AssertNot(S, '%', 'pattern rules are not listed as targets'); + AssertNot(S, 'CC', 'variable lines are not targets'); + AssertHas(S, 'Git branch: feature/x', 'branch parsed from .git/HEAD'); + AssertHas(S, 'git status', 'points the model at git status for tree state'); + WriteLn(' ok: Makefile + git facts'); + + { package.json scripts; Makefile still owns Build/Test. } + WriteText(Dir + '/package.json', + '{"name":"x","scripts":{"build":"vite build","test":"vitest run","dev":"vite"}}'); + S := BuildProjectFactsSection(Dir); + AssertHas(S, 'Node (package.json)', 'stack names Node'); + AssertHas(S, 'npm run build', 'npm build script listed'); + AssertHas(S, 'npm test', 'npm test script listed'); + AssertHas(S, 'Build: make', 'Makefile still owns the build command'); + WriteLn(' ok: package.json scripts'); + + { Cargo-only dir: cargo fills build/test. } + Nuke(Dir); ForceDirectories(Dir); + WriteText(Dir + '/Cargo.toml', '[package]'#10'name = "x"'#10); + S := BuildProjectFactsSection(Dir); + AssertHas(S, 'Rust (Cargo.toml)', 'stack names Rust'); + AssertHas(S, 'Build: cargo build', 'cargo build'); + AssertHas(S, 'Test: cargo test', 'cargo test'); + WriteLn(' ok: Cargo fallback'); + + { Detached HEAD. } + ForceDirectories(Dir + '/.git'); + WriteText(Dir + '/.git/HEAD', 'deadbeefcafe1234'#10); + S := BuildProjectFactsSection(Dir); + AssertHas(S, '(detached: deadbeefcafe', 'detached HEAD reported'); + WriteLn(' ok: detached HEAD'); + + Nuke(Dir); + WriteLn('PASS'); +end.