From 063708ba535653659560e7e75bc511b9dc485068 Mon Sep 17 00:00:00 2001 From: Colby Mchenry Date: Fri, 30 Oct 2026 14:29:03 +0000 Subject: [PATCH] fix(pascal): Delphi chained calls and method pointers follow declared types (#3065) Four Delphi bugs that PR 2550 by @OleksiyPenkov found, reimplemented on main's Pascal scope code rather than as a second resolver: - A call through a chain of members and methods recorded only the outer method's bare name, which name matching gave to any namesake: SynEdit's Canvas.Font.Assign(Font) went to TProposalColumn::Assign, and TLogger2.Create.Write('y') linked nothing, a bare Write being a System name. The extractor now writes such a call as the typed chain pascal-scope already resolves for paren-less names ({call} for a statement, a new {args} mode for a last link written with its arguments). Each link is typed by its declaration: field and property types, function results, a local's declared type, through pointer and class reference types (PVirtualNode = ^TVirtualNode, TSynLogClass = class of TSynLog) and explicit dereferences (a^.Copy). A constructor called on a class gives an instance of it, a unit name, dotted ones too, qualifies its declarations, and a chain called with arguments may end at data that holds a routine. There is no bare fallback: a chain through a type from outside the project links nothing, and in a with body only a chain from Self or a typed local is read. - A method given to a target was a method pointer only when the target was named On.../FOn...: Callback := FProvider.Value with Callback: TGet recorded a call, and FOnGet := @FProvider.Value nothing. A value given to an assignment now carries its target, whose declared type decides (routine types written out, of object, reference to, project aliases, the RTL's routine type names; a class, a record or a System value type holds no routine); the name decides only where the declaration can't be read. A function that returns a routine type is called for it, and @Obj.Method is a reference anywhere. - A nested routine's locals leaked into the routine around it: the name matcher's Pascal receiver scan read every declaration above the call. It now steps over routines nested elsewhere, reads the calling routine's own name lists (Doc, Doc2: TDocVariantData), which main typed only by luck through a nested routine's parameter, and follows pointer and class reference types. Where the tree has errors, the source-text scopes give the outer routine its own names back after a nested one. - A nested routine declared forward is in scope from that declaration. Validation: - New __tests__/pascal-reference-boundaries.test.ts, 41 tests, 24 of them ported from PR 2550: 22 fail on main's sources, the other 19 pin what main already got right. pascal-chained-calls and pascal-for-in-var pinned the bare outer-method names and now expect the typed chains (4 tests, failing on main). Twenty mutations, one per rule, each fail a test. - A/B against main 80f6b505, both arms built from their own sources and diffed by natural keys, edges removed/added: SynEdit 195/66, HeidiSQL 789/320, mORMot2 2553/4164, DelphiMVCFramework 2394/1850, DWScript without its Test folder of scripts (519 files) 864/801. leveldb and SDWebImage byte-identical. - Removed edges, hand-triaged: SynEdit all 195, 193 namesakes or parse artifacts and 2 right ones lost (Get(i).LoadFromStream in a with body); samples of HeidiSQL 20/20, DelphiMVCFramework 30/30, DWScript 12/12 and mORMot2 23/25 namesakes (of the other two, one now links the unit's own CompareMem, and one right edge is lost, through a field declared after the first name of a name list, which the extractor gives no node). - Added edges sampled right: typed chains 186 of 187 (the wrong one reaches the FMX variant of a conditional ancestor), receiver calls 40/40, method pointers, @-references and kind changes 57/57. - CPU, median of 3 interleaved: SynEdit +6.6%, HeidiSQL +0.6%, mORMot2 -2.5%, DWScript +4.7%, while the identical controls moved 0.0% and -5.9%. DelphiMVCFramework, timed before the scan's memo was split per routine (which only made it cheaper): -6.6%. Reimplements part of PR 2550 by @OleksiyPenkov. Co-Authored-By: Claude Opus 5.5 --- CHANGELOG.md | 1 + __tests__/pascal-chained-calls.test.ts | 40 +- __tests__/pascal-for-in-var.test.ts | 6 +- __tests__/pascal-reference-boundaries.test.ts | 1006 +++++++++++++++++ src/extraction/tree-sitter.ts | 214 +++- src/resolution/name-matcher.ts | 188 ++- src/resolution/pascal-scope.ts | 228 +++- 7 files changed, 1558 insertions(+), 125 deletions(-) create mode 100644 __tests__/pascal-reference-boundaries.test.ts diff --git a/CHANGELOG.md b/CHANGELOG.md index 94ace836b..04a9daac0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -51,6 +51,7 @@ and adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). - In Delphi, a routine called without parentheses, the usual way to call one that takes no arguments, like `Before;`, `if Ready then`, `Result := FProvider.Value + 1` or `QueryTabs.ActiveTab.MemoFilename`, now counts as a call, so it shows up in callers, callees and impact, and a method given to an event, like `OnClick := ButtonClick`, is linked as a reference. A name is linked only to a method or function its code reaches, in its class and the classes it inherits from (`class sealed (TBase)` included), its unit, or the units it uses, never to a field, property or variable of that name. Thanks @OleksiyPenkov for the report, and @equipados, @drakeo338 and @OleksiyPenkov for their pull requests. (#2514) - In Delphi, a call to something the compiler provides, like `SizeOf(X)`, `TypeInfo(TFoo)`, `High(A)`, `Inc(N)`, `Assert(…)` or a typecast like `Pointer(P)`, written in any letter case, no longer shows up as a call to a project method, field or variable that happens to share its name, unless the calling code's own class or units declare one, like a list class's own `Delete`. A call through a field, property or variable now counts only when it holds a routine, like an `OnChange` event or a `reference to function` variable, and calls in `{$I}` include files and into units the parser could only partly read now find the routines those units declare. Thanks @OleksiyPenkov for the report. (#2514) - In Delphi, a routine declared inside another, between its header and its `begin`, is now indexed as a routine of its own under the one it belongs to (`TFoo.Bar`'s `Inner` is `TFoo::Bar::Inner`), with the calls its body makes. Before, its body was skipped, so what it called was missing from callers and impact, and a call to it from its own routine went to any routine of the same name elsewhere. Thanks @OleksiyPenkov for the pull request this follows. (#2550) +- In Delphi, a call through a chain of fields and methods, like `FProjectPanel.ActiveModelSeries.BeginUpdate;`, `TLogger.Create.Write('x')` or `Node.Parent.SetChildCount(1)` on a record pointer, now links to the method of the class each step is declared to give, instead of any method that shares the last name, and links nothing when that class comes from outside the project. A method given to a field, property or variable of an event or other routine type, like `Callback := FProvider.Value` or `FOnGet := @FProvider.Value`, now counts as a reference whatever the target is called, while one given to a plain value is still a call. A routine nested in another no longer lends its local variables to the code around it, a call on a variable declared together with others (`Doc, Doc2: TDocVariantData`) reaches its type's method, and a nested routine declared `forward` is found by the calls written before its body. Thanks @OleksiyPenkov. - In Delphi, a unit that re-publishes an inherited property, like `property OwnsObjects;` or `property Cursor default crIBeam;`, is now indexed whole. So is one with a conditional right after a routine's header (`{$IFDEF HASINLINE}inline;{$ENDIF}`), an assembler and a Pascal version of one routine, a bare `raise`, a field or variable of an unnamed record type (`fIn: record … end`), a label just before `end`, or two versions of a statement in one `case` branch. Before, the parse broke at such a line, so the routines and class members after it went missing or their calls were credited to the file, which cost SynEdit's main unit most of its code. - In Delphi, a constant read in a routine's body is no longer credited to the last routine nested inside it. - In VB.NET and C#, what a property's `Get` and `Set` code calls, creates and reads now belongs to that property, as do C#'s `get => …` accessors and `=> …` property bodies. Before, it was dropped, so a method used only from a property looked unused. diff --git a/__tests__/pascal-chained-calls.test.ts b/__tests__/pascal-chained-calls.test.ts index 6a581db24..37116b001 100644 --- a/__tests__/pascal-chained-calls.test.ts +++ b/__tests__/pascal-chained-calls.test.ts @@ -82,6 +82,15 @@ function refsFrom(code: string, qualifiedName: string, kind = 'calls'): string[] .sort(); } +/** + * The outer methods of chains through members and calls, which resolution + * types link by link (#2550): `{args}.A.B.C` for one written with its + * arguments, `{call}.A.B.C` for a statement. + */ +function chainsFrom(code: string, qualifiedName: string): string[] { + return refsFrom(code, qualifiedName, 'references').filter((r) => /^\{(?:args|call)[@}]/.test(r)); +} + async function withIndex(code: string, check: (cg: CodeGraph) => void): Promise { const dir = fs.mkdtempSync(path.join(os.tmpdir(), 'cg-pascal-chain-')); try { @@ -109,8 +118,10 @@ function edgesFrom(cg: CodeGraph, sourceName: string): string[] { describe('Delphi chained calls (#2547)', () => { it('records the receiver call and the calls in its arguments', () => { - expect(refsFrom(CHAIN_PAS, 'TargetIsTheSame')).toEqual(['IsSame:41', 'MD5FileSized:41', 'TMeta.ExtendedPath:41']); - expect(refsFrom(CHAIN_PAS, 'Stmt')).toEqual(['MD5FileSized:46', 'Reset:46', 'TMeta.ExtendedPath:46']); + expect(refsFrom(CHAIN_PAS, 'TargetIsTheSame')).toEqual(['MD5FileSized:41', 'TMeta.ExtendedPath:41']); + expect(chainsFrom(CHAIN_PAS, 'TargetIsTheSame')).toEqual(['{args}.MD5FileSized.IsSame:41']); + expect(refsFrom(CHAIN_PAS, 'Stmt')).toEqual(['MD5FileSized:46', 'TMeta.ExtendedPath:46']); + expect(chainsFrom(CHAIN_PAS, 'Stmt')).toEqual(['{call}.MD5FileSized.Reset:46']); }); it('links each routine to all three callees the issue names', async () => { @@ -144,18 +155,19 @@ end; end. `; - // `B`, `C` (line 10), `Ready`, `Value` and `Prop` are paren-less links: reads, not calls. + // `B`, `C` (line 10), `Ready`, `Value` and `Prop` are paren-less links: + // reads, not calls. `C` (line 9) and `Method` end chains, typed link by + // link (#2550). expect(refsFrom(code, 'Run')).toEqual([ 'A:10', 'A:9', - 'C:9', 'F:11', 'Find:13', 'Free:12', 'GetHandler:14', 'GetIndex:12', - 'Method:15', ]); + expect(chainsFrom(code, 'Run')).toEqual(['{args}.A.B.C:9', '{args}.Obj.Prop.Method:15']); }); it('names a fluent chain\'s inner links only where they can be named precisely', () => { @@ -174,11 +186,19 @@ end; end. `; - // The outer `Get` keeps the name a call has always had. `BaseURL` and - // `Accept` would be bare names on a chain whose type is unknown, which - // match namesakes, so they are left out; `RESTClient.HandleRedirects` - // and `Builder.WithName` name their receiver. - expect(refsFrom(code, 'Run')).toEqual(['Build:11', 'Builder.WithName:11', 'Get:10', 'Get:9', 'RESTClient.HandleRedirects:10']); + // `RESTClient.HandleRedirects` and `Builder.WithName` name their + // receiver. Every later link is written as its chain (#2550), which + // links only what each link is declared to give, never a namesake of a + // bare `Get`, `BaseURL` or `Accept`. + expect(refsFrom(code, 'Run')).toEqual(['Builder.WithName:11', 'RESTClient.HandleRedirects:10']); + expect(chainsFrom(code, 'Run')).toEqual([ + '{args}.Client.New.BaseURL.Accept.Get:9', + '{args}.Client.New.BaseURL.Accept:9', + '{args}.Client.New.BaseURL:9', + '{args}.RESTClient.HandleRedirects.Accept.Get:10', + '{args}.RESTClient.HandleRedirects.Accept:10', + '{call}.Builder.WithName.Build:11', + ]); }); it('gives a factory its caller and still resolves the chain on what it returns', async () => { diff --git a/__tests__/pascal-for-in-var.test.ts b/__tests__/pascal-for-in-var.test.ts index 0d782bdb2..186a60fa5 100644 --- a/__tests__/pascal-for-in-var.test.ts +++ b/__tests__/pascal-for-in-var.test.ts @@ -175,10 +175,10 @@ end. } finally { tree.delete(); } - // `P.Value.Clear` keeps the bare method name the extractor gives a chain - // on a variable; the anonymous method's call belongs to `Run`. + // `P.Value.Clear` is a chain on a loop variable whose type the parse + // doesn't keep, so no bare `Clear` is named for it (#2550); the anonymous + // method's call belongs to `Run`. expect(callsFrom(code, 'Run', 'Forms.pas')).toEqual([ - 'Clear:10', 'Q.Free:11', 'TParallel.For:12', 'X.Reset:14', diff --git a/__tests__/pascal-reference-boundaries.test.ts b/__tests__/pascal-reference-boundaries.test.ts new file mode 100644 index 000000000..763b64579 --- /dev/null +++ b/__tests__/pascal-reference-boundaries.test.ts @@ -0,0 +1,1006 @@ +/** + * Where a Delphi call or method pointer stops being what its spelling says + * (#2550): a call through a chain of members and functions + * (`FPanel.ActiveSeries.BeginUpdate;`, `TLogger.Create.Write('x')`) is a + * method of what the chain's links are declared to be, never a namesake; a + * method given to a field, a local or a property whose declared type is a + * routine type is a method pointer whatever the target is called, and so is + * `@Obj.Method`; a routine nested in another keeps its locals to itself; and + * a nested routine declared `forward` is in scope from that declaration. + * + * The cases in the first two blocks are ported from @OleksiyPenkov's tests + * in #2550, which found these bugs. + */ +import { describe, it, expect, beforeAll, beforeEach, afterEach } from 'vitest'; +import * as fs from 'node:fs'; +import * as os from 'node:os'; +import * as path from 'node:path'; +import { CodeGraph } from '../src'; +import { initGrammars, loadGrammarsForLanguages } from '../src/extraction/grammars'; + +beforeAll(async () => { + await initGrammars(); + await loadGrammarsForLanguages(['pascal']); +}); + +let directory: string; +let graph: CodeGraph | undefined; +beforeEach(() => { + directory = fs.mkdtempSync(path.join(os.tmpdir(), 'cg-pascal-boundaries-')); +}); +afterEach(() => { + graph?.close(); + graph = undefined; + fs.rmSync(directory, { recursive: true, force: true, maxRetries: 5 }); +}); + +async function index(files: Record): Promise { + for (const [name, text] of Object.entries(files)) fs.writeFileSync(path.join(directory, name), text); + graph = await CodeGraph.init(directory, { index: true }); + return graph; +} + +function routine(qualifiedName: string) { + const node = graph!.getNodesByKind('method').concat(graph!.getNodesByKind('function')).find((n) => n.qualifiedName === qualifiedName); + expect(node, qualifiedName).toBeDefined(); + return node!; +} + +/** The calls and references a routine makes, as `kind:Target`, once each. */ +function dependencies(qualifiedName: string): string[] { + return [...new Set(graph!.getOutgoingEdges(routine(qualifiedName).id) + .filter((e) => e.kind === 'calls' || e.kind === 'references') + .map((e) => `${e.kind}:${graph!.getNode(e.target)!.qualifiedName}`))].sort(); +} + +/** The routines that call a method, by name, once each. */ +function callerNamesOf(qualifiedName: string): string[] { + const target = graph!.getNodesByKind('method').find((n) => n.qualifiedName === qualifiedName); + if (!target) return []; + return [...new Set(graph!.getIncomingEdges(target.id).filter((e) => e.kind === 'calls') + .map((e) => graph!.getNode(e.source)?.name).filter((n): n is string => !!n))].sort(); +} + +describe('Pascal reference boundaries (#2550)', () => { + it('keeps calls to overloaded methods on their declared receiver', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TLog = class + procedure Add(const S: string); overload; + procedure Add(I: Integer); overload; + end; +implementation +procedure TLog.Add(const S: string); begin end; +procedure TLog.Add(I: Integer); begin end; +procedure Run(Log: TLog); begin Log.Add('x'); end; +end.` }); + expect(dependencies('Run')).toEqual(['calls:TLog::Add']); + }); + + it.each([ + ['argument constructor', 'constructor Create(I: Integer);', 'constructor TBuilder.Create(I: Integer); begin end;', 'TBuilder.Create(1).Build;'], + ['inherited constructor', '', '', 'TBuilder.Create().Build;'], + ])('keeps the constructed receiver type for an %s', async (_name, declaration, implementation, call) => { + await index({ 'Main.pas': `unit Main; +interface +type + TBuilder = class(TObject) + ${declaration} + procedure Build; + end; + TDecoy = class procedure Build; end; +implementation + ${implementation} +procedure TBuilder.Build; begin end; +procedure TDecoy.Build; begin end; +procedure Run; begin ${call} end; +end.` }); + expect(dependencies('Run')).toContain('calls:TBuilder::Build'); + expect(dependencies('Run')).not.toContain('calls:TDecoy::Build'); + }); + + it.each([ + ['plain', 'FPanel.Series.GetCount'], + ['address-of', '@FPanel.Series.GetCount'], + ])('evaluates intermediate receivers in a %s method-pointer assignment', async (_name, rhs) => { + await index({ 'Main.pas': `unit Main; +interface +type + TGet = function: Integer of object; + TSeries = class function GetCount: Integer; end; + TPanel = class function Series: TSeries; end; + TConsumer = class + FPanel: TPanel; + Callback: TGet; + procedure Wire; + end; +implementation +function TSeries.GetCount: Integer; begin Result := 1; end; +function TPanel.Series: TSeries; begin Result := nil; end; +procedure TConsumer.Wire; begin Callback := ${rhs}; end; +end.` }); + expect(dependencies('TConsumer::Wire')).toEqual(['calls:TPanel::Series', 'references:TSeries::GetCount']); + }); + + it('references procedure handlers even when the event type is external', async () => { + await index({ 'Main.pas': `unit Main; +interface +uses System.Classes; +type + TController = class procedure HandleClick(Sender: TObject); end; + TConsumer = class + FController: TController; + Callback: TNotifyEvent; + procedure Wire; + end; +implementation +procedure TController.HandleClick(Sender: TObject); begin end; +procedure TConsumer.Wire; begin Callback := FController.HandleClick; end; +end.` }); + expect(dependencies('TConsumer::Wire')).toEqual(['references:TController::HandleClick']); + }); + + it('calls a factory that returns a callback instead of referencing the factory', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TGet = function: Integer of object; + TFactory = class function MakeHandler: TGet; end; + TConsumer = class + FFactory: TFactory; + Callback: TGet; + procedure Wire; + end; +implementation +function TFactory.MakeHandler: TGet; begin Result := nil; end; +procedure TConsumer.Wire; begin Callback := FFactory.MakeHandler; end; +end.` }); + expect(dependencies('TConsumer::Wire')).toEqual(['calls:TFactory::MakeHandler']); + }); + + it.each([ + ['else', 'if Ready then Callback := FProvider.Value else Callback := nil;'], + ['end', 'Callback := FProvider.Value'], + ])('references a handler before %s without a semicolon', async (_name, body) => { + await index({ 'Main.pas': `unit Main; +interface +type + TGet = function: Integer of object; + TProvider = class function Value: Integer; end; + TConsumer = class + FProvider: TProvider; + Callback: TGet; + Ready: Boolean; + procedure Wire; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +procedure TConsumer.Wire; begin ${body} end; +end.` }); + expect(dependencies('TConsumer::Wire')).toEqual(['references:TProvider::Value']); + }); + + it('resolves chains through a forward-declared class', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TModel = class; + TPanel = class Model: TModel; end; + TModel = class procedure Recalc; end; +implementation +procedure TModel.Recalc; begin end; +procedure Run(Panel: TPanel); begin Panel.Model.Recalc; end; +end.` }); + expect(dependencies('Run')).toEqual(['calls:TModel::Recalc']); + }); + + it('records a parameterless Self method used as a root receiver', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TPanel = class procedure Refresh; end; + TConsumer = class + function ActivePanel: TPanel; + procedure Run; + end; +implementation +procedure TPanel.Refresh; begin end; +function TConsumer.ActivePanel: TPanel; begin Result := nil; end; +procedure TConsumer.Run; begin ActivePanel.Refresh; end; +end.` }); + expect(dependencies('TConsumer::Run')).toEqual(['calls:TConsumer::ActivePanel', 'calls:TPanel::Refresh']); + }); + + it('resolves a global receiver imported from another unit', async () => { + await index({ + 'Globals.pas': `unit Globals; +interface +type + TPanel = class procedure Refresh; end; + TApplication = class Panel: TPanel; end; +var MainForm: TApplication; +implementation +procedure TPanel.Refresh; begin end; +end.`, + 'Main.pas': `unit Main; +interface +uses Globals; +implementation +procedure Run; begin MainForm.Panel.Refresh; end; +end.`, + }); + expect(dependencies('Run')).toEqual(['calls:TPanel::Refresh']); + }); + + it('resolves unit-qualified class receivers', async () => { + await index({ + 'Builders.pas': `unit Builders; +interface +type TBuilder = class procedure Build; end; +implementation +procedure TBuilder.Build; begin end; +end.`, + 'Main.pas': `unit Main; +interface +uses Builders; +implementation +procedure Run; begin Builders.TBuilder.Create().Build; end; +end.`, + }); + expect(dependencies('Run')).toEqual(['calls:TBuilder::Build']); + }); + + it('does not use a field type when an inline local shadows that field', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TField = class procedure Run; end; + TLocal = class procedure Run; end; + TConsumer = class + Receiver: TField; + procedure UseLocal; + end; +implementation +procedure TField.Run; begin end; +procedure TLocal.Run; begin end; +procedure TConsumer.UseLocal; +begin + var Receiver: TLocal; + Receiver.Run; +end; +end.` }); + expect(dependencies('TConsumer::UseLocal')).toEqual(['calls:TLocal::Run']); + }); + + it('keeps typed as-cast receiver calls', async () => { + await index({ 'Main.pas': `unit Main; +interface +type TPanel = class procedure Refresh; end; +implementation +procedure TPanel.Refresh; begin end; +procedure Run(Sender: TObject); begin (Sender as TPanel).Refresh; end; +end.` }); + expect(dependencies('Run')).toEqual(['calls:TPanel::Refresh']); + }); + + it('keeps calls on indexed receivers', async () => { + await index({ 'Main.pas': `unit Main; +interface +type TPanel = class procedure Refresh; end; +implementation +procedure TPanel.Refresh; begin end; +procedure Run; var Panels: array of TPanel; begin Panels[0].Refresh; end; +end.` }); + expect(dependencies('Run')).toEqual(['calls:TPanel::Refresh']); + }); + + it('does not bind an external receiver to an unrelated same-named method', async () => { + await index({ 'Main.pas': `unit Main; +interface +uses System.Classes; +type TDecoy = class procedure Clear; end; +implementation +procedure TDecoy.Clear; begin end; +procedure Run(List: TStringList); begin List.Clear; end; +end.` }); + expect(dependencies('Run')).toEqual([]); + }); + + it.each([ + ['after nested declaration', 'var Receiver: TLocal;', 'calls:TLocal::Run'], + ['nested local does not escape', '', 'calls:TField::Run'], + ])('scopes locals when a %s exists', async (_name, locals, expected) => { + await index({ 'Main.pas': `unit Main; +interface +type + TField = class procedure Run; end; + TLocal = class procedure Run; end; + TConsumer = class Receiver: TField; procedure UseLocal; end; +implementation +procedure TField.Run; begin end; +procedure TLocal.Run; begin end; +procedure TConsumer.UseLocal; + procedure Inner; + var Receiver: TLocal; + begin end; + ${locals} +begin Receiver.Run; end; +end.` }); + expect(dependencies('TConsumer::UseLocal')).toEqual([expected]); + }); + + it('does not infer field types from unrelated method parameters', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TGet = function: Integer of object; + TProvider = class function Value: Integer; end; + TDecoy = class function Value: Integer; end; + TConsumer = class + procedure Other(FProvider: TDecoy; Callback: TGet); + FProvider: TProvider; + Callback: Integer; + procedure Evaluate; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +function TDecoy.Value: Integer; begin Result := 2; end; +procedure TConsumer.Other(FProvider: TDecoy; Callback: TGet); begin end; +procedure TConsumer.Evaluate; begin Callback := FProvider.Value; end; +end.` }); + expect(dependencies('TConsumer::Evaluate')).toEqual(['calls:TProvider::Value']); + }); + + it('does not turn a field hiding an inherited method into a call', async () => { + await index({ 'Main.pas': `unit Main; +interface +type + TBase = class function Visible: Boolean; end; + TSeries = class(TBase) Visible: Boolean; end; + TConsumer = class + Series: TSeries; + function Evaluate: Boolean; + end; +implementation +function TBase.Visible: Boolean; begin Result := True; end; +function TConsumer.Evaluate: Boolean; begin Result := Series.Visible; end; +end.` }); + expect(dependencies('TConsumer::Evaluate')).toEqual([]); + }); +}); + +describe('Pascal calls without parentheses, from #2550\'s resolution cases', () => { + it('extracts paren-less method calls inside expressions', async () => { + await index({ 'UnitA.pas': `unit UnitA; +interface +type + TProvider = class + public + function Value: Integer; + function ValueParens(): Integer; + public + Count: Integer; + property Total: Integer read Value; + end; + TConsumer = class + private + FProvider: TProvider; + public + function UseNoParens: Integer; + function UseParens: Integer; + function UseFieldRead: Integer; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +function TProvider.ValueParens(): Integer; begin Result := 2; end; +function TConsumer.UseNoParens: Integer; +begin + Result := FProvider.Value + 1; +end; +function TConsumer.UseParens: Integer; +begin + Result := FProvider.ValueParens() + 1; +end; +function TConsumer.UseFieldRead: Integer; +begin + Result := FProvider.Count + FProvider.Total; +end; +end. +` }); + expect(callerNamesOf('TProvider::ValueParens')).toEqual(['UseParens']); + // Reading the field `Count` or the property `Total` draws no call. + expect(callerNamesOf('TProvider::Value')).toEqual(['UseNoParens']); + expect(graph!.getOutgoingEdges(routine('TConsumer::UseFieldRead').id).filter((e) => e.kind === 'calls')).toEqual([]); + }); + + it('records each method evaluated in an instance receiver chain', async () => { + await index({ 'Chain.pas': `unit Chain; +interface +type + TSeries = class + Visible: Boolean; + procedure BeginUpdate; + end; + TPanel = class + function ActiveModelSeries: TSeries; + end; + TConsumer = class + FProjectPanel: TPanel; + procedure UseStatement; + procedure UseExplicit; + function UseCondition: Boolean; + function UseAssignment: TSeries; + end; + TDecoy = class + function Visible: Boolean; + procedure BeginUpdate; + end; +implementation +procedure TSeries.BeginUpdate; begin end; +function TPanel.ActiveModelSeries: TSeries; begin Result := nil; end; +procedure TConsumer.UseStatement; +begin FProjectPanel.ActiveModelSeries.BeginUpdate; end; +procedure TConsumer.UseExplicit; +begin FProjectPanel.ActiveModelSeries().BeginUpdate(); end; +function TConsumer.UseCondition: Boolean; +begin + if FProjectPanel.ActiveModelSeries.Visible then Result := True; +end; +function TConsumer.UseAssignment: TSeries; +begin Result := FProjectPanel.ActiveModelSeries; end; +function TDecoy.Visible: Boolean; begin Result := False; end; +procedure TDecoy.BeginUpdate; begin end; +end.` }); + expect(callerNamesOf('TPanel::ActiveModelSeries')).toEqual(['UseAssignment', 'UseCondition', 'UseExplicit', 'UseStatement']); + expect(callerNamesOf('TSeries::BeginUpdate')).toEqual(['UseExplicit', 'UseStatement']); + expect(callerNamesOf('TDecoy::BeginUpdate')).toEqual([]); + expect(callerNamesOf('TDecoy::Visible')).toEqual([]); + }); + + it('distinguishes method-pointer assignments from evaluated function results', async () => { + await index({ + 'Provider.pas': `unit Provider; +interface +type + TGetIntEvent = function: Integer of object; + TEventAlias = TGetIntEvent; + TProvider = class + function Value: Integer; + end; + TEvents = class + FOnGet: TEventAlias; + property OnGet: TEventAlias read FOnGet write FOnGet; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +end.`, + 'Consumer.pas': `unit Consumer; +interface +uses Provider; +type + TConsumer = class + FProvider: TProvider; + FEvents: TEvents; + FOnGet: TGetIntEvent; + procedure Wire; + function Evaluate: Integer; + property OnGet: TGetIntEvent read FOnGet write FOnGet; + end; +implementation +procedure TConsumer.Wire; +var Callback: TEventAlias; +begin + OnGet := + FProvider.Value; + FOnGet := FProvider.Value; + FEvents.OnGet := FProvider.Value; + Callback := FProvider.Value; +end; +function TConsumer.Evaluate: Integer; +var Number: Integer; +begin + Number := FProvider.Value; + Result := FProvider.Value; +end; +end.`, + }); + const value = routine('TProvider::Value'); + const wire = graph!.getOutgoingEdges(routine('TConsumer::Wire').id).filter((e) => e.target === value.id); + const evaluate = graph!.getOutgoingEdges(routine('TConsumer::Evaluate').id).filter((e) => e.target === value.id); + expect(wire.filter((e) => e.kind === 'calls')).toEqual([]); + expect(wire.filter((e) => e.kind === 'references').map((e) => e.line).sort((a, b) => a! - b!)).toEqual([18, 19, 20, 21]); + expect(evaluate.filter((e) => e.kind === 'calls').map((e) => e.line).sort((a, b) => a! - b!)).toEqual([26, 27]); + }); +}); + +/** The edges a routine makes, as `line kind:Target`, in line order. */ +function edgesByLine(qualifiedName: string): string[] { + return graph!.getOutgoingEdges(routine(qualifiedName).id) + .filter((e) => e.kind === 'calls' || e.kind === 'references') + .map((e) => `${e.line} ${e.kind}:${graph!.getNode(e.target)!.qualifiedName}`) + .sort((a, b) => parseInt(a, 10) - parseInt(b, 10) || a.localeCompare(b)); +} + +describe('Delphi chains, method pointers, nested scopes and forward routines (#2550)', () => { + it('calls the method of what a constructor makes, the class\'s own or inherited', async () => { + await index({ 'Wire.pas': `unit Wire; +interface +type + TLogger2 = class procedure Emit(const S: string); procedure Write(const S: string); end; + TBuilder = class constructor Make(N: Integer); procedure Build; end; + TDecoy = class procedure Emit(const S: string); procedure Write(const S: string); procedure Build; end; + TWirer = class procedure CallEmit; end; +implementation +procedure TLogger2.Emit(const S: string); begin end; +procedure TLogger2.Write(const S: string); begin end; +constructor TBuilder.Make(N: Integer); begin end; +procedure TBuilder.Build; begin end; +procedure TDecoy.Emit(const S: string); begin end; +procedure TDecoy.Write(const S: string); begin end; +procedure TDecoy.Build; begin end; +procedure TWirer.CallEmit; +begin + TLogger2.Create.Emit('x'); + TLogger2.Create.Write('y'); + TBuilder.Make(1).Build; +end; +end.` }); + expect(edgesByLine('TWirer::CallEmit')).toEqual([ + '18 calls:TLogger2::Emit', '19 calls:TLogger2::Write', '20 calls:TBuilder::Build', '20 calls:TBuilder::Make', + ]); + }); + + it('reads a class its unit\'s name qualifies, through its constructor', async () => { + await index({ + 'Logger.pas': `unit Logger; +interface +type TLogger = class procedure Write(const S: string); end; +implementation +procedure TLogger.Write(const S: string); begin end; +end.`, + 'Scope.pas': `unit Scope; +interface +uses Logger; +implementation +procedure RunLog; begin Logger.TLogger.Create.Write('x'); end; +procedure RunLog2; begin Logger.TLogger.Create().Write('x'); end; +end.`, + }); + expect(dependencies('RunLog')).toEqual(['calls:TLogger::Write']); + expect(dependencies('RunLog2')).toEqual(['calls:TLogger::Write']); + }); + + it('reads a routine a dotted unit name qualifies', async () => { + await index({ + 'My.Core.Utils.pas': `unit My.Core.Utils; +interface +function Helper(N: Integer): Integer; +procedure Reset; +implementation +function Helper(N: Integer): Integer; begin Result := N; end; +procedure Reset; begin end; +end.`, + 'App.pas': `unit App; +interface +uses My.Core.Utils; +implementation +procedure Run; +var X: Integer; +begin + X := My.Core.Utils.Helper(1); + My.Core.Utils.Reset; +end; +end.`, + }); + expect(dependencies('Run')).toEqual(['calls:Helper', 'calls:Reset']); + }); + + it('links no namesake for a chain through a type from outside the project', async () => { + await index({ 'Main.pas': `unit Main; +interface +uses Vcl.ExtCtrls; +type + TDecoy = class procedure Clear; procedure Refresh(N: Integer); end; + TOwner = class + FPanel: TPanel; + procedure Run; + end; +implementation +procedure TDecoy.Clear; begin end; +procedure TDecoy.Refresh(N: Integer); begin end; +procedure TOwner.Run; +begin + FPanel.Controls.Clear; + FPanel.Parent.Refresh(1); +end; +end.` }); + expect(dependencies('TOwner::Run')).toEqual([]); + }); + + it('gives a method pointer to a local of a routine type, named, aliased or written out', async () => { + await index({ 'Wire.pas': `unit Wire; +interface +type + TGet = function: Integer of object; + TGetAlias = TGet; + TProvider = class function Value: Integer; end; + TWirer = class + FProvider: TProvider; + procedure Locals; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +procedure TWirer.Locals; +var + Named: TGet; + Aliased: TGetAlias; + Written: function: Integer of object; + Closure: reference to function: Integer; + Number: Integer; +begin + Named := FProvider.Value; + Aliased := FProvider.Value; + Written := FProvider.Value; + Closure := FProvider.Value; + Number := FProvider.Value; +end; +end.` }); + expect(edgesByLine('TWirer::Locals')).toEqual([ + '21 references:TProvider::Value', '22 references:TProvider::Value', '23 references:TProvider::Value', + '24 references:TProvider::Value', '25 calls:TProvider::Value', + ]); + }); + + it('takes `@Obj.Method` for a method pointer, whatever it is given to', async () => { + await index({ 'Wire.pas': `unit Wire; +interface +type + TGet = function: Integer of object; + TProvider = class function Value: Integer; end; + TWirer = class + FProvider: TProvider; + Callback: TGet; + FOnGet: TGet; + function Own: Integer; + procedure AtOnNamed; + procedure AtCallback; + procedure AtBareOwn; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +function TWirer.Own: Integer; begin Result := 2; end; +procedure TWirer.AtOnNamed; begin FOnGet := @FProvider.Value; end; +procedure TWirer.AtCallback; begin Callback := @FProvider.Value; end; +procedure TWirer.AtBareOwn; begin Callback := @Own; end; +end.` }); + expect(dependencies('TWirer::AtOnNamed')).toEqual(['references:TProvider::Value']); + expect(dependencies('TWirer::AtCallback')).toEqual(['references:TProvider::Value']); + expect(dependencies('TWirer::AtBareOwn')).toEqual(['references:TWirer::Own']); + }); + + it('calls a function given to a target named like an event that holds data', async () => { + await index({ 'Wire.pas': `unit Wire; +interface +type + TProvider = class function Value: Integer; function IsTop: Boolean; end; + TWirer = class + FProvider: TProvider; + FOnCount: Integer; + FOnTop: Boolean; + procedure Wire; + end; +implementation +function TProvider.Value: Integer; begin Result := 1; end; +function TProvider.IsTop: Boolean; begin Result := True; end; +procedure TWirer.Wire; +begin + FOnCount := FProvider.Value; + FOnTop := FProvider.IsTop; +end; +end.` }); + expect(edgesByLine('TWirer::Wire')).toEqual(['16 calls:TProvider::Value', '17 calls:TProvider::IsTop']); + }); + + it('keeps a nested routine\'s locals to it, and the routine around it its own', async () => { + await index({ 'Scope.pas': `unit Scope; +interface +type + TField = class procedure Run; end; + TLocal = class procedure Run; end; + TScoped = class Receiver: TField; procedure UseLocalNested; end; +implementation +procedure TField.Run; begin end; +procedure TLocal.Run; begin end; +procedure TScoped.UseLocalNested; + procedure Inner; + var Receiver: TLocal; + begin Receiver.Run; end; +begin Receiver.Run; end; +end.` }); + expect(dependencies('TScoped::UseLocalNested::Inner')).toEqual(['calls:TLocal::Run']); + expect(dependencies('TScoped::UseLocalNested')).toEqual(['calls:TField::Run']); + }); + + it('types a receiver by the routine\'s own name list, not a nested routine\'s parameter', async () => { + await index({ 'Docs.pas': `unit Docs; +interface +type + TDocData = class procedure Clear; end; + TOther = class procedure Clear; end; + TItem = class procedure Clear; end; + TTests = class procedure Run; end; +implementation +procedure TDocData.Clear; begin end; +procedure TOther.Clear; begin end; +procedure TItem.Clear; begin end; +procedure TTests.Run; + procedure Check(var Item: TOther); + begin + Item.Clear; + end; +var + Item, Spare: TDocData; +begin + Item.Clear; + Spare.Clear; +end; +end.` }); + expect(dependencies('TTests::Run::Check')).toEqual(['calls:TOther::Clear']); + expect(edgesByLine('TTests::Run')).toEqual(['20 calls:TDocData::Clear', '21 calls:TDocData::Clear']); + }); + + it('calls a class method through a class reference type', async () => { + await index({ 'Meta.pas': `unit Meta; +interface +type + TFoo = class + class function Make(N: Integer): TFoo; + end; + TFooClass = class of TFoo; + TOther = class + class function Make(N: Integer): TOther; + end; +procedure Run(Cls: TFooClass); +implementation +class function TFoo.Make(N: Integer): TFoo; begin Result := nil; end; +class function TOther.Make(N: Integer): TOther; begin Result := nil; end; +procedure Run(Cls: TFooClass); +begin + Cls.Make(1); +end; +end.` }); + expect(dependencies('Run')).toEqual(['calls:TFoo::Make']); + }); + + it('reads no other routine\'s name list for a receiver', async () => { + await index({ 'Mongo.pas': `unit Mongo; +interface +type + RawUtf8 = type AnsiString; + TMongoDatabase = class + procedure RunCommand(const Cmd: string); + end; + TMongoRequest = class + constructor Create(const Database, Collection: RawUtf8); + end; + TMongoCollection = class + function GetDatabase: TMongoDatabase; + property Database: TMongoDatabase read GetDatabase; + procedure Aggregate; + end; +implementation +procedure TMongoDatabase.RunCommand(const Cmd: string); begin end; +constructor TMongoRequest.Create(const Database, Collection: RawUtf8); begin end; +function TMongoCollection.GetDatabase: TMongoDatabase; begin Result := nil; end; +procedure TMongoCollection.Aggregate; +begin + Database.RunCommand('x'); +end; +end.` }); + expect(dependencies('TMongoCollection::Aggregate')).toEqual(['calls:TMongoDatabase::RunCommand']); + }); + + it('calls the record\'s method through a pointer to it, declared alone or in a name list', async () => { + await index({ 'Ptr.pas': `unit Ptr; +interface +type + PBigInt = ^TBigInt; + TBigInt = record + procedure RightShift(N: Integer); + end; + TOther = class + procedure RightShift(N: Integer); + end; +procedure Single(q: PBigInt); +procedure Listed; +implementation +procedure TBigInt.RightShift(N: Integer); begin end; +procedure TOther.RightShift(N: Integer); begin end; +procedure Single(q: PBigInt); +begin + q.RightShift(2); +end; +procedure Listed; +var + q, r1: PBigInt; +begin + q.RightShift(2); +end; +end.` }); + expect(dependencies('Single')).toEqual(['calls:TBigInt::RightShift']); + expect(dependencies('Listed')).toEqual(['calls:TBigInt::RightShift']); + }); + + it('reads a chain through a class reference type and an explicit dereference', async () => { + await index({ 'Logs.pas': `unit Logs; +interface +type + TSynLog = class + class function Add: TSynLog; + procedure Log(const Msg: string); + end; + TSynLogClass = class of TSynLog; + ISynLogLike = interface + procedure Log(const Msg: string); + end; + PBigInt = ^TBigInt; + TBigInt = record + function Copy: PBigInt; + function MultiplyLow(Other: PBigInt): PBigInt; + end; + TDecoy = class + function MultiplyLow(Other: Pointer): Pointer; + end; +var + DBLog: TSynLogClass; +procedure Run(a, b: PBigInt); +implementation +class function TSynLog.Add: TSynLog; begin Result := nil; end; +procedure TSynLog.Log(const Msg: string); begin end; +function TBigInt.Copy: PBigInt; begin Result := @Self; end; +function TBigInt.MultiplyLow(Other: PBigInt): PBigInt; begin Result := @Self; end; +function TDecoy.MultiplyLow(Other: Pointer): Pointer; begin Result := nil; end; +procedure Run(a, b: PBigInt); +begin + DBLog.Add.Log('x'); + a^.Copy.MultiplyLow(b); +end; +end.` }); + const run = dependencies('Run'); + expect(run).toEqual(expect.arrayContaining(['calls:TSynLog::Add', 'calls:TSynLog::Log', 'calls:TBigInt::MultiplyLow'])); + expect(run).not.toContain('calls:ISynLogLike::Log'); + expect(run).not.toContain('calls:TDecoy::MultiplyLow'); + }); + + it('reads a chain in a with body only from a name the routine declares', async () => { + await index({ 'Emf.pas': `unit Emf; +interface +type + TCanvas2 = class procedure Stroke; end; + TEnum = class Canvas: TCanvas2; end; + TDecoy = class procedure Stroke; end; + TRec = record X: Integer; end; + PRec = ^TRec; + THost = class + FEnum: TEnum; + procedure Run(R: PRec; E: TEnum); + end; +implementation +procedure TCanvas2.Stroke; begin end; +procedure TDecoy.Stroke; begin end; +procedure THost.Run(R: PRec; E: TEnum); +begin + with R^ do + begin + E.Canvas.Stroke; + FEnum.Canvas.Stroke; + end; +end; +end.` }); + // `FEnum` may be the with object's member, which only its type could say. + expect(edgesByLine('THost::Run')).toEqual(['20 calls:TCanvas2::Stroke']); + }); + + it('reads a chain through pointer types, which Delphi dereferences', async () => { + await index({ 'Tree.pas': `unit Tree; +interface +type + PNode = ^TNode; + TNode = record + LastChild: PNode; + procedure SetNextSibling(Value: PNode); + end; + TDecoy = class + procedure SetNextSibling(Value: Pointer); + end; +procedure Attach(Node, Child: PNode); +implementation +procedure TNode.SetNextSibling(Value: PNode); begin end; +procedure TDecoy.SetNextSibling(Value: Pointer); begin end; +procedure Attach(Node, Child: PNode); +begin + Node.LastChild.SetNextSibling(Child); +end; +end.` }); + expect(dependencies('Attach')).toEqual(['calls:TNode::SetNextSibling']); + }); + + it('keeps a nested routine\'s locals to it where the unit\'s tree has errors', async () => { + // The old-style `begin … end.` initialization breaks the unit's parse, + // so the routines' names come from the source text. + await index({ 'Brk.pas': `unit Brk; + +interface + +type + TField = class + function Value: Integer; + end; + TLocal = class + function Value: Integer; + end; + TScoped = class + Receiver: TField; + function UseLocal: Integer; + end; + +implementation + +function TField.Value: Integer; +begin + Result := 1; +end; + +function TLocal.Value: Integer; +begin + Result := 2; +end; + +function TScoped.UseLocal: Integer; + + procedure Inner; + var + Receiver: TLocal; + begin + Receiver := nil; + end; + +var + N: Integer; +begin + N := Receiver.Value; + Result := N; +end; + +begin +end. +` }); + expect(dependencies('TScoped::UseLocal')).toEqual(['calls:TField::Value']); + }); + + it('calls a nested routine declared forward above the call', async () => { + await index({ 'Scope.pas': `unit Scope; +interface +type + TScoped = class procedure Fire; end; +implementation +procedure TScoped.Fire; + procedure Late; forward; + function Later(N: Integer; + M: Integer): Integer; forward; + procedure Early; + begin + Late; + Later(1, 2); + end; + procedure Late; begin end; + function Later(N: Integer; M: Integer): Integer; begin Result := N + M; end; +begin + Early; +end; +end.` }); + expect(dependencies('TScoped::Fire::Early')).toEqual(['calls:TScoped::Fire::Late', 'calls:TScoped::Fire::Later']); + expect(dependencies('TScoped::Fire')).toEqual(['calls:TScoped::Fire::Early']); + }); +}); diff --git a/src/extraction/tree-sitter.ts b/src/extraction/tree-sitter.ts index 7203ed684..a8a738951 100644 --- a/src/extraction/tree-sitter.ts +++ b/src/extraction/tree-sitter.ts @@ -798,6 +798,17 @@ interface PascalTextRoutine { */ type PascalNameMode = 'call' | 'read' | 'ref' | 'recv'; +/** + * The declared type a Pascal local takes when it is written out as a routine + * type (`procedure of object`, `reference to function: Integer`), which no + * class stands for: a method given to it is a method pointer (#2550). The + * source text reads the same word off such a declaration. + */ +const PASCAL_ROUTINE_TYPE = 'procedure'; + +/** A routine header in Pascal source text, its indentation and its dotted name captured (#2514). */ +const PASCAL_TEXT_HEADER = /^(\s*)(?:class\s+)?(?:procedure|function|constructor|destructor|operator)\s+([A-Za-z_]\w*(?:<[^>]*>)?(?:\.[A-Za-z_]\w*(?:<[^>]*>)?)*)/i; + /** * Names Delphi's conventions give to data, never to a routine: a field * (`FCount`), a type (`TList`, `EAbort`), a constant (`MAX_PATH`, `CRLF`). @@ -9135,12 +9146,18 @@ export class TreeSitterExtractor { /** The names a parameter, `var` or `const` declaration declares, with the type it gives them (see pascalRoutineLocals). */ private declarePascalLocal(names: Map, decl: SyntaxNode): void { - const type = this.pascalTypeName(decl.namedChildren.find((c: SyntaxNode) => c.type === 'type' || c.type === 'typeref')); + const type = this.pascalLocalTypeName(decl.namedChildren.find((c: SyntaxNode) => c.type === 'type' || c.type === 'typeref')); for (const c of decl.namedChildren) { if (c.type === 'identifier') names.set(getNodeText(c, this.source).toLowerCase(), type); } } + /** A local's declared type as pascalTypeName names it, or PASCAL_ROUTINE_TYPE for a routine type written out. */ + private pascalLocalTypeName(type: SyntaxNode | null | undefined): string | null { + if (type?.type === 'type' && type.namedChild(0)?.type === 'declProcRef') return PASCAL_ROUTINE_TYPE; + return this.pascalTypeName(type); + } + /** * A name a routine's body declares where it stands — an inline `var`, a * `for` or `for … in` loop's variable, an `on E: EFoo do` handler's — joins @@ -9158,7 +9175,7 @@ export class TreeSitterExtractor { switch (node.type) { case 'varAssignDef': case 'varDef': { - let type = this.pascalTypeName(node.namedChildren.find((c: SyntaxNode) => c.type === 'typeref' || c.type === 'type')); + let type = this.pascalLocalTypeName(node.namedChildren.find((c: SyntaxNode) => c.type === 'typeref' || c.type === 'type')); const value = node.parent?.type === 'assignment' ? node.parent.namedChild(node.parent.namedChildCount - 1) : null; if (!type && value?.type === 'exprDot') { // `var List := TStringList.Create;` @@ -9231,12 +9248,14 @@ export class TreeSitterExtractor { innerCallee = getNodeText(innerFirst, this.source); } // Gate on the Delphi type-naming convention — `TFoo` classes / `IFoo` - // interfaces — so a class-factory chain re-encodes but a capitalized - // VARIABLE/parameter chain (Pascal capitalizes locals too: `Curve.X().Y()`, - // `Self.X().Y()`) stays bare and keeps its existing bare-name resolution. - calleeName = innerCallee && /^[TI][A-Z]/.test(innerCallee) - ? `${innerCallee}().${method}` - : method; + // interfaces — so a class-factory chain re-encodes. Any other chain + // (`FPanel.Series().Clear(1)`, `Self.X().Y()`) is typed link by link + // (#2550), never left to the outer method's bare name. + if (innerCallee && /^[TI][A-Z]/.test(innerCallee)) calleeName = `${innerCallee}().${method}`; + else this.pushPascalChainCall(firstChild, 'args', node); + } else if (firstChild.namedChild(0)?.type === 'exprDot') { + // `FPanel.Series.Clear(1)`, `TLog.Create.Write('x')` (#2550). + this.pushPascalChainCall(firstChild, 'args', node); } else { // Qualified call: Obj.Method(...) const identifiers = firstChild.namedChildren.filter( @@ -9369,7 +9388,10 @@ export class TreeSitterExtractor { if (receiver.type === 'exprCall') this.extractPascalReceiverCall(receiver, false); else this.extractPascalParenlessCall(receiver); } else { - calleeName = method; // non-class receiver: a bare method ref (no field-access ref) + // A chain through members and functions (`FPanel.Series.BeginUpdate;`) + // runs a method of what its links are declared to be, never a + // namesake of its last name (#2550). + this.pushPascalChainCall(node, 'call', node); this.extractPascalReceiverCalls(receiver); // `MD5FileSized(…).Reset;` (#2547) } } else { @@ -9392,6 +9414,65 @@ export class TreeSitterExtractor { } } + /** + * The outer method of a Pascal call through a chain of members and + * functions (#2550): `FPanel.Series.BeginUpdate;` (`call`, a statement) or + * `FPanel.Series().Clear(1)`, `TLog.Create.Write('x')` (`args`, written with + * its arguments). Recorded as `{mode@Class}.Head.Link.Method` (see + * resolution/pascal-scope), which links the method of what each link is + * declared to be or nothing, never a namesake of the last name; a head the + * routine declares is written as its declared type (`:TPanel`). In a + * `with` body, where a name may be the `with` object's member, only a chain + * from `Self` or from a name the routine declares with its type is + * recorded (`with PEMRPolyLine(R)^ do E.Canvas.MoveToI(…)`). Nothing is + * recorded for a chain with a link that is no name (`Items[0].Series.Clear`). + */ + private pushPascalChainCall(callee: SyntaxNode, mode: 'call' | 'args', at: SyntaxNode): void { + if (this.isPascalHeaderName(callee)) return; + const callerId = this.nodeStack[this.nodeStack.length - 1]; + const scope = this.pascalScopeAt(at.startPosition.row + 1); + const links = this.pascalChainLinks(callee); + if (!callerId || !scope || !links) return; + const local = this.pascalLocalType(links[0]!.toLowerCase(), scope.locals); + if (this.pascalWithDepth > 0 && !local && links[0]!.toLowerCase() !== 'self') return; + if (local !== undefined) { + if (local === null || local === PASCAL_ROUTINE_TYPE) return; + links[0] = `:${local}`; + } + this.unresolvedReferences.push({ + fromNodeId: callerId, + referenceName: `{${mode}${scope.classQn ? `@${scope.classQn}` : ''}}.${links.join('.')}`, + referenceKind: 'references', + line: at.startPosition.row + 1, + column: at.startPosition.column, + }); + } + + /** + * The links of a Pascal chain of names and calls, head first, the calls' + * arguments and dereferences left out (`Logger.TLog.Create().Write` → + * Logger, TLog, Create, Write; `GetPanel(1).Series` → GetPanel, Series; + * `a^.Copy` → a, Copy, as Delphi dereferences a pointer for a member + * anyway), or null when a link is anything else (an index, a cast in + * parentheses, a generic type). + */ + private pascalChainLinks(node: SyntaxNode): string[] | null { + const links: string[] = []; + let n: SyntaxNode | null = node; + while (n?.type === 'exprDot' || n?.type === 'exprCall' || + (n?.type === 'exprUnary' && n.namedChild(n.namedChildCount - 1)?.type === 'kHat')) { + if (n.type === 'exprDot') { + const last = n.namedChild(n.namedChildCount - 1); + if (last?.type !== 'identifier') return null; + links.unshift(getNodeText(last, this.source)); + } + n = n.namedChild(0); + } + if (n?.type !== 'identifier') return null; + links.unshift(getNodeText(n, this.source)); + return links; + } + /** * Recursively visit a Pascal block/statement tree for call expressions. * With `declarations`, a declaration in it is visited as a declaration. @@ -9485,12 +9566,21 @@ export class TreeSitterExtractor { if (PASCAL_NOT_ROUTINES.has(lower) || this.pascalLocalType(lower, scope.locals) !== undefined) return; if (this.pascalDataNames(scope.classQn).has(lower)) return; } - const mode: PascalNameMode | null = parent ? this.pascalNameMode(name, parent) : 'recv'; + let mode: PascalNameMode | null = parent ? this.pascalNameMode(name, parent) : 'recv'; if (!mode) return; // In a `with` body a name may be the `with` object's member, which the // object's type would have to say. Only the method an event is given is // linked there (`OnClick := ButtonClick`), the form's, as it is written. if (this.pascalWithDepth > 0 && (mode !== 'ref' || name.type !== 'identifier')) return; + // A value given to an assignment's target carries the target, whose + // declared type says whether a method given to it is a method pointer; + // the mode its name gives stands where its declaration doesn't (#2550). + let target = ''; + if (parent?.type === 'assignment' && this.pascalWithDepth === 0) { + const assigned = this.pascalAssignmentTarget(parent.namedChild(0), scope.locals); + if (assigned && 'mode' in assigned) mode = assigned.mode; + else if (assigned) target = `=${assigned.target}`; + } let path: string[]; if (name.type === 'identifier') { path = [getNodeText(name, this.source)]; @@ -9517,7 +9607,7 @@ export class TreeSitterExtractor { // A local's declared class stands for it; a pointer type (`PNode`), // which no class node declares, can't. A local's member as a receiver // is left out: what it reaches is almost always data. - if (local === null || mode === 'recv' || /^P[A-Z]/.test(local)) return; + if (local === null || local === PASCAL_ROUTINE_TYPE || mode === 'recv' || /^P[A-Z]/.test(local)) return; path[0] = `:${local}`; } else if (lower !== 'self' && PASCAL_NOT_ROUTINES.has(lower)) { return; @@ -9526,7 +9616,7 @@ export class TreeSitterExtractor { // file when the implementation matched no declaration. const ref: UnresolvedReference = { fromNodeId: callerId, - referenceName: `{${mode}${scope.classQn ? `@${scope.classQn}` : ''}}.${path.join('.')}`, + referenceName: `{${mode}${target}${scope.classQn ? `@${scope.classQn}` : ''}}.${path.join('.')}`, referenceKind: 'references', line: name.startPosition.row + 1, column: name.startPosition.column, @@ -9631,49 +9721,85 @@ export class TreeSitterExtractor { * `Result`'s type, `var` and `const` sections — and where the unit's own * code resumes: after an `end;` that starts its line, which closes a * routine, and at `initialization` and `finalization`. An indented header - * is a routine nested in the one above, whose class and names it shares. + * is a routine nested in the one above, whose class it shares, and whose + * names it sees. Where the routine it is nested in goes on — a declaration + * section or a body indented less than its header — that routine's names + * are back, its own section's with them, and the nested routine's are gone + * (#2550). */ private readPascalTextRoutines(): PascalTextRoutine[] { const lines = (this.pascalSourceLines ??= this.source.split(/\r?\n/)); - const header = /^(\s*)(?:class\s+)?(?:procedure|function|constructor|destructor|operator)\s+([A-Za-z_]\w*(?:<[^>]*>)?(?:\.[A-Za-z_]\w*(?:<[^>]*>)?)*)/i; const routines: PascalTextRoutine[] = []; let outer: PascalTextRoutine | null = null; + // The outer routine and the routines nested in it the text is in, with + // how far their headers are indented and the names each sees, innermost last. + let open: Array<{ indent: number; locals: Map }> = []; for (let i = 0; i < lines.length; i++) { const text = lines[i]!; if (/^(?:end;|\s*(?:initialization|finalization)\b)/i.test(text)) { routines.push({ line: i + 1, classQn: null, routine: null, locals: new Map() }); outer = null; + open = []; continue; } - const m = header.exec(text); - if (!m) continue; - const nested: boolean = m[1] !== '' && outer !== null; + const m = PASCAL_TEXT_HEADER.exec(text); + if (!m) { + const section = open.length > 1 ? /^(\s*)(var|const|type|label|resourcestring|threadvar|begin|asm)\b/i.exec(text) : null; + if (section && section[1]!.length < open[open.length - 1]!.indent) { + while (open.length > 1 && open[open.length - 1]!.indent > section[1]!.length) open.pop(); + const resumed = open[open.length - 1]!; + if (/^(?:var|const)$/i.test(section[2]!)) { + resumed.locals = new Map(resumed.locals); + this.readPascalTextDeclarations(lines, i, text.slice(section[0].length), resumed.locals); + } + routines.push({ line: i + 1, classQn: outer!.classQn, routine: outer!.routine, locals: resumed.locals }); + } + continue; + } + const indent = m[1]!.length; + const nested: boolean = indent > 0 && outer !== null; const parts = m[2]!.replace(/<[^>]*>/g, '').split('.'); const routine = parts.pop()!.toLowerCase(); - let decl = text.slice(m.index + m[0].length); - for (let j = i + 1; j < lines.length && j <= i + 200 && !/^\s*(?:begin|asm)\b/i.test(lines[j]!) && !header.test(lines[j]!); j++) { - decl += '\n' + lines[j]; - } - decl = decl.replace(/\{[^}]*\}|\(\*[\s\S]*?\*\)|\/\/[^\n]*/g, ' '); - const locals: Map = new Map(nested ? outer!.locals : []); - const result = /^\s*(?:\([^)]*\))?\s*:\s*([A-Za-z_][\w.]*)/.exec(decl); + // A sibling's names, or a deeper routine's, are no longer seen. + while (nested && open.length > 1 && open[open.length - 1]!.indent >= indent) open.pop(); + const locals: Map = new Map(nested ? open[open.length - 1]!.locals : []); + const result = /^\s*(?:\([^)]*\))?\s*:\s*([A-Za-z_][\w.]*)/.exec( + this.readPascalTextDeclarations(lines, i, text.slice(m.index + m[0].length), locals)); locals.set('result', result ? result[1]!.split('.').pop()! : null); - for (const d of decl.matchAll(/([A-Za-z_]\w*(?:\s*,\s*[A-Za-z_]\w*)*)\s*:(?!=)\s*([A-Za-z_][\w.]*)?/g)) { - const type = d[2] ? d[2].split('.').pop()! : null; - for (const name of d[1]!.split(',')) locals.set(name.trim().toLowerCase(), type); - } if (nested) { // The outer routine's body follows its nested ones: it keeps the - // outer routine's class and name, and sees the names of both. + // outer routine's class and name. routines.push({ line: i + 1, classQn: outer!.classQn, routine: outer!.routine, locals }); + open.push({ indent, locals }); } else { outer = { line: i + 1, classQn: parts.length > 0 ? parts.join('::') : null, routine, locals }; routines.push(outer); + open = [{ indent, locals }]; } } return routines; } + /** + * The declarations the source text makes from line `from` on, `text` its + * part not yet read, up to a body or the next routine header, added to + * `locals` (see readPascalTextRoutines). Returns the text read, its + * comments blanked. + */ + private readPascalTextDeclarations(lines: string[], from: number, text: string, locals: Map): string { + let decl = text; + for (let j = from + 1; j < lines.length && j <= from + 200 && !/^\s*(?:begin|asm)\b/i.test(lines[j]!) && !PASCAL_TEXT_HEADER.test(lines[j]!); j++) { + decl += '\n' + lines[j]; + } + decl = decl.replace(/\{[^}]*\}|\(\*[\s\S]*?\*\)|\/\/[^\n]*/g, ' '); + for (const d of decl.matchAll(/([A-Za-z_]\w*(?:\s*,\s*[A-Za-z_]\w*)*)\s*:(?!=)\s*([A-Za-z_][\w.]*)?/g)) { + // A routine type written out (`procedure of object`, `reference to …`). + const type = !d[2] ? null : /^(?:procedure|function|reference)$/i.test(d[2]) ? PASCAL_ROUTINE_TYPE : d[2].split('.').pop()!; + for (const name of d[1]!.split(',')) locals.set(name.trim().toLowerCase(), type); + } + return decl; + } + /** * How a name in `parent` may run a parameterless routine: `call` as a * statement of its own, `read` for its value in an expression or an @@ -9703,7 +9829,10 @@ export class TreeSitterExtractor { return op && (op.type === 'kIs' || op.type === 'kAs') && parent.namedChild(0)?.id !== name.id ? null : 'read'; } case 'exprUnary': - return parent.child(0)?.type === 'kAt' ? null : 'read'; + // `@Obj.Method` takes a method's address, a method pointer whatever it + // is given to (#2550); `@Handler` is a function value (#756). + if (parent.child(0)?.type === 'kAt') return name.type === 'exprDot' ? 'ref' : null; + return 'read'; case 'if': case 'ifElse': case 'while': @@ -9722,6 +9851,31 @@ export class TreeSitterExtractor { } } + /** + * An assignment's target, for what a method given to it is (#2550): its + * name or dotted name (`Callback`, `FEvents.OnGet`, `Self.OnGet`), which + * resolution looks up, a local written as its declared type (`:TGet`); the + * mode itself for a local declared with a routine type written out (`ref`) + * or with a type no name stands for (`read`, an array or a set); null when + * the target is no name (`Items[0]`, `TFoo(X).OnGet`). + */ + private pascalAssignmentTarget( + target: SyntaxNode | null, + textLocals: Map | null, + ): { target: string } | { mode: PascalNameMode } | null { + const links = target?.type === 'identifier' + ? [getNodeText(target, this.source)] + : target?.type === 'exprDot' ? this.pascalIdentifierPath(target) : null; + if (!links) return null; + const local = this.pascalLocalType(links[0]!.toLowerCase(), textLocals); + if (local !== undefined) { + if (links.length === 1 && (local === null || local === PASCAL_ROUTINE_TYPE)) return { mode: local ? 'ref' : 'read' }; + if (local === null || local === PASCAL_ROUTINE_TYPE) return null; + links[0] = `:${local}`; + } + return { target: links.join('.') }; + } + /** The identifiers of a plain dotted name (`FProvider.Value`, `Self.A.B`), or null. */ private pascalIdentifierPath(dot: SyntaxNode): string[] | null { const links: string[] = []; diff --git a/src/resolution/name-matcher.ts b/src/resolution/name-matcher.ts index 17a8abda0..c01c1b6a6 100644 --- a/src/resolution/name-matcher.ts +++ b/src/resolution/name-matcher.ts @@ -20964,6 +20964,9 @@ export function clearNameMatcherMemos(context: ResolutionContext): void { KOTLIN_RECEIVER_TYPES.delete(context); KOTLIN_HIERARCHIES.delete(context); KOTLIN_FRAMES.delete(context); + PASCAL_NESTED_LINES.delete(context); + PASCAL_POINTEES.delete(context); + PASCAL_HEADER_LINES.delete(context); clearCppNamespaceMemos(context); clearCppRawStringMemos(context); CPP_FILE_TYPE_NAMES.delete(context); @@ -21685,6 +21688,92 @@ function typeParameterBoundIn(typeName: string, decls: Node[], context: Resoluti return declared ? null : undefined; } +const PASCAL_NESTED_LINES = new WeakMap boolean) | null>>(); +const PASCAL_POINTEES = new WeakMap>(); +const PASCAL_HEADER_LINES = new WeakMap>(); + +/** + * The line (0-based) of the routine header that starts a line at or above + * `callIdx` in a Pascal file (`procedure TFoo.Bar;`), where the calling + * routine's own declarations begin; 0 when there is none (#2550). + */ +function pascalRoutineHeaderIndex(filePath: string, lines: string[], callIdx: number, context: ResolutionContext): number { + let memo = PASCAL_HEADER_LINES.get(context); + if (!memo) PASCAL_HEADER_LINES.set(context, (memo = new Map())); + let headers = memo.get(filePath); + if (!headers) { + headers = []; + for (let i = 0; i < lines.length; i++) { + if (/^(?:class\s+)?(?:procedure|function|constructor|destructor|operator)\s+[A-Za-z_]/i.test(lines[i]!)) headers.push(i); + } + memo.set(filePath, headers); + } + let lo = 0; + let hi = headers.length - 1; + let hit = 0; + while (lo <= hi) { + const mid = (lo + hi) >> 1; + if (headers[mid]! <= callIdx) { + hit = headers[mid]!; + lo = mid + 1; + } else { + hi = mid - 1; + } + } + return hit; +} + +/** + * The type a Pascal pointer or class reference type the project declares + * stands for (`PDBObject = ^TDBObject` → `TDBObject`, `TSynLogClass = class + * of TSynLog` → `TSynLog`), whose members a value of it reaches, or null for + * any other type (#2550). + */ +function pascalPointee(typeName: string, context: ResolutionContext): string | null { + let memo = PASCAL_POINTEES.get(context); + if (!memo) PASCAL_POINTEES.set(context, (memo = new Map())); + const lower = typeName.toLowerCase(); + if (memo.has(lower)) return memo.get(lower)!; + let pointee: string | null = null; + for (const n of context.getNodesByLowerName(lower)) { + if (n.language !== 'pascal' || n.kind !== 'type_alias') continue; + const lines = context.getFileLines?.(n.filePath) ?? context.readFile(n.filePath)?.split(/\r?\n/) ?? []; + const m = /=\s*(?:\^|class\s+of\b)\s*([A-Za-z_]\w*)/i.exec((lines[n.startLine - 1] ?? '').replace(/\/\/.*$|\{[^}]*\}/g, ' ')); + if (m) { + pointee = m[1]!; + break; + } + } + memo.set(lower, pointee); + return pointee; +} + +/** + * Whether a line (0-based) of a Pascal file is inside a routine nested in + * another (`procedure Inner;` between `procedure TFoo.Bar;` and its body) + * that a backward scan from `startIdx` (see enclosingScopeStartLine) isn't + * inside: what such a routine declares, its parameters and its locals, is + * its own, not the routine around it's or a later one's (#2550). Null when + * the file has none. + */ +function pascalNestedRoutineLines(filePath: string, startIdx: number, context: ResolutionContext): ((i: number) => boolean) | null { + let memo = PASCAL_NESTED_LINES.get(context); + if (!memo) PASCAL_NESTED_LINES.set(context, (memo = new Map())); + const key = `${filePath}|${startIdx}`; + if (memo.has(key)) return memo.get(key)!; + // A nested routine is a function qualified under the routine it is in. + const spans: Array<[number, number]> = []; + for (const n of context.getNodesInFile(filePath)) { + if (n.kind !== 'function' || n.language !== 'pascal' || !n.qualifiedName.includes('::')) continue; + const start = n.startLine - 1; + const end = (n.endLine ?? n.startLine) - 1; + if (start > startIdx || end < startIdx) spans.push([start, end]); + } + const inside = spans.length === 0 ? null : (i: number): boolean => spans.some(([start, end]) => i >= start && i <= end); + memo.set(key, inside); + return inside; +} + /** 1-based start line of the tightest function/method enclosing the call. */ function enclosingScopeStartLine(ref: UnresolvedRef, context: ResolutionContext): number { let start = 1; @@ -21828,20 +21917,34 @@ export function inferLocalReceiverType( const startIdx = componentScoped ? 0 : Math.max(0, enclosingScopeStartLine(ref, context) - 1); + // A Pascal routine nested in another declares its names for itself, and the + // calling routine's own declarations name a receiver in a name list too + // (`Doc, Doc2: TDocVariantData`), unlike another routine's above it (#2550). + const nestedElsewhere = ref.language === 'pascal' ? pascalNestedRoutineLines(ref.filePath, startIdx, context) : null; + const ownFrom = ref.language === 'pascal' + ? Math.max(startIdx, pascalRoutineHeaderIndex(ref.filePath, lines, callIdx, context)) + : -1; + const withListed = ownFrom >= 0 + ? memoPatterns(`pascal-listed|${escapedReceiver}`, () => + [...patterns, new RegExp(`\\b${escapedReceiver}\\b(?:\\s*,\\s*[A-Za-z_]\\w*)+\\s*:\\s*([A-Z][\\w]*)`)]) + : patterns; // The raw capture behind matchLine's latest non-null answer (see `decl`). let lastRaw: string | undefined; const matchLine = (i: number): string | null => { const line = lines[i]; - if (!line) return null; + if (!line || nestedElsewhere?.(i)) return null; // A generated/minified line (one multi-KB statement) is not something a // human-written local declaration lives on, and regexing it per ref is // pure waste — skip it rather than scan it. if (line.length > 10_000) return null; - for (const re of patterns) { + for (const re of i >= ownFrom ? withListed : patterns) { const m = line.match(re); if (m && m[1]) { - const type = ref.language === 'java' ? javaTypeName(m[1]) : normalizeInferredTypeName(m[1]); + let type = ref.language === 'java' ? javaTypeName(m[1]) : normalizeInferredTypeName(m[1]); + // Delphi dereferences a pointer for a member (`P.Method` is + // `P^.Method`), and a class reference reaches its class's methods. + if (type && ref.language === 'pascal') type = pascalPointee(type, context) ?? type; if (type) { lastRaw = m[1]; return type; @@ -21867,12 +21970,45 @@ export function inferLocalReceiverType( if (!componentScoped) { const states = getInferScanStates(context); const key = `${ref.filePath}|${startIdx}|${ref.language}|${scanReceiver}`; - const state = states.get(key); - if (!state) { - for (let i = callIdx; i >= startIdx; i--) { + // query(hi) over [lo..hi] under one memo key (see above). + const scan = (stateKey: string, lo: number, hi: number): string | null => { + const state = states.get(stateKey); + if (!state) { + for (let i = hi; i >= lo; i--) { + const type = matchLine(i); + if (type) { + states.set(stateKey, { hi, ansIdx: i, ansType: type, ansRaw: lastRaw }); + if (decl) { + decl.raw = lastRaw; + decl.line = i + 1; + } + return type; + } + } + states.set(stateKey, { hi, ansIdx: -1, ansType: null }); + return null; + } + if (hi >= state.hi) { + for (let i = hi; i > state.hi; i--) { + const type = matchLine(i); + if (type) { + state.ansIdx = i; + state.ansType = type; + state.ansRaw = lastRaw; + break; + } + } + state.hi = hi; + if (state.ansIdx < lo) return null; + if (decl) { + decl.raw = state.ansRaw; + decl.line = state.ansIdx + 1; + } + return state.ansType; + } + for (let i = hi; i >= lo; i--) { const type = matchLine(i); if (type) { - states.set(key, { hi: callIdx, ansIdx: i, ansType: type, ansRaw: lastRaw }); if (decl) { decl.raw = lastRaw; decl.line = i + 1; @@ -21880,38 +22016,16 @@ export function inferLocalReceiverType( return type; } } - states.set(key, { hi: callIdx, ansIdx: -1, ansType: null }); return null; + }; + // A Pascal routine's own lines, where its name lists count, are scanned + // under a key of their own; the lines above it under the shared one, + // which every routine of the file extends in turn (see ownFrom). + if (ownFrom >= 0) { + const own = scan(`${key}|${ownFrom}`, ownFrom, callIdx); + return own !== null || ownFrom <= startIdx ? own : scan(key, startIdx, ownFrom - 1); } - if (callIdx >= state.hi) { - for (let i = callIdx; i > state.hi; i--) { - const type = matchLine(i); - if (type) { - state.ansIdx = i; - state.ansType = type; - state.ansRaw = lastRaw; - break; - } - } - state.hi = callIdx; - if (state.ansIdx < startIdx) return null; - if (decl) { - decl.raw = state.ansRaw; - decl.line = state.ansIdx + 1; - } - return state.ansType; - } - for (let i = callIdx; i >= startIdx; i--) { - const type = matchLine(i); - if (type) { - if (decl) { - decl.raw = lastRaw; - decl.line = i + 1; - } - return type; - } - } - return null; + return scan(key, startIdx, callIdx); } // Nearest declaration wins: scan backward from the call to the scope start. diff --git a/src/resolution/pascal-scope.ts b/src/resolution/pascal-scope.ts index 9f74e9812..10ac23ae1 100644 --- a/src/resolution/pascal-scope.ts +++ b/src/resolution/pascal-scope.ts @@ -12,10 +12,21 @@ * - `{ref}` — the value given to an event (`OnClick := Handler`), a method * pointer; * - `{recv}` — a receiver (`GetList` in `GetList.Count`, `B` in `A.B.C`) or - * an indexed value, which only a function can be. + * an indexed value, which only a function can be; + * - `{args}` — the last link of a chain called with its arguments written + * (`FPanel.Series().Clear(1)`, `TLog.Create.Write('x')`), which runs it (#2550). * * Written without its arguments, a routine that needs some is a method - * pointer too, in any of them. + * pointer too, in any of them. A chain of more than one link (`{call}.A.B.C`) + * is the outer method of a call through members and functions, typed by what + * each link is declared to be, never a namesake by its name alone (#2550). + * + * A value assigned to a target carries the target after an `=` + * (`{read=Callback}.FProvider.Value`, `{ref=FOnGet}`, a local's declared type + * as `{read=:TGet}`): a target whose declared type is a routine type is given + * a method pointer, whatever it is called, and one of any other type a value; + * the mode, from the target's name (`OnClick`, `FOnGet`), decides only where + * its declaration doesn't say (#2550). * * The routine's class follows an `@` (`{call@TConsumer}.Before`), because the * reference's own node is the file when an implementation matched no @@ -36,14 +47,14 @@ import type { ResolutionContext, ResolvedRef, UnresolvedRef } from './types'; import { declaredSupertypes } from './name-matcher'; import { PASCAL_SYSTEM_NAMES } from '../extraction/languages/pascal-system'; -type Mode = 'call' | 'read' | 'ref' | 'recv'; +type Mode = 'call' | 'read' | 'ref' | 'recv' | 'args'; interface Found { node: Node; resolvedBy: ResolvedRef['resolvedBy']; confidence: number; } -const PARENLESS = /^\{(call|read|ref|recv)(?:@([^}]+))?\}\.(.+)$/; +const PARENLESS = /^\{(call|read|ref|recv|args)(?:=([^@}]+))?(?:@([^}]+))?\}\.(.+)$/; const CLASS_KINDS: ReadonlySet = new Set(['class', 'struct', 'interface']); /** What a unit declares by name at its top level. */ const UNIT_KINDS: ReadonlySet = new Set([ @@ -71,30 +82,46 @@ export function isPascalParenlessRef(ref: UnresolvedRef): boolean { export function matchPascalParenlessRef(ref: UnresolvedRef, context: ResolutionContext): ResolvedRef | null { const m = PARENLESS.exec(ref.referenceName); if (!m) return null; - const mode = m[1] as Mode; - const path = m[3]!.split('.'); + let mode = m[1] as Mode; + const target = m[2]; + const path = m[4]!.split('.'); // Most such names read data, often the framework's: a name no Pascal - // routine has is settled here, before any lookup in scope. - if (routineNames(context)?.has(path[path.length - 1]!.toLowerCase()) === false) return null; + // routine has is settled here, before any lookup in scope. Called with its + // arguments, a chain may end at data that holds a routine. + if (mode !== 'args' && routineNames(context)?.has(path[path.length - 1]!.toLowerCase()) === false) return null; let cls: Node | null = null; - if (m[2]) { - cls = classByQualifiedName(m[2], ref.filePath!, context); + if (m[3]) { + cls = classByQualifiedName(m[3], ref.filePath!, context); } else { const routine = context.getNodeById?.(ref.fromNodeId); if (routine) cls = classOfRoutine(routine, context); } - const found = path.length === 1 ? nameInScope(path[0]!, cls, ref, context) : memberThroughPath(path, cls, ref, context); + const found = path.length === 1 + ? nameInScope(path[0]!, cls, ref, context) + : memberThroughPath(path, cls, ref, context, mode === 'args'); if (!found) return null; - // Written without arguments, a routine that needs some can only be a - // method pointer — save a constructor, whose name then means an inherited - // one outside the project (`TObject.Create`) — and so is a procedure read - // for a value, and an event's method; any other runs. - const needsArgs = needsArguments(found.node); - if (needsArgs && routineKeyword(found.node, context) === 'constructor') return null; - const pointer = mode === 'ref' || needsArgs || (mode !== 'call' && !yieldsValue(found.node, context)); - // A statement runs its routine, and a receiver is a routine's value. - if (pointer && (mode === 'call' || mode === 'recv')) return null; - const edgeKind = pointer ? 'references' : 'calls'; + let edgeKind: 'calls' | 'references' = 'calls'; + // Written with its arguments, the routine runs, or the routine the data holds. + if (mode !== 'args') { + if (target !== undefined) { + // Given to a target, a method is a method pointer when the target's + // declared type is a routine type, and a value otherwise. A function + // whose result is a routine type is called for it. + const routineTyped = assignedRoutineType(target, cls, ref, context); + if (routineTyped !== undefined) mode = routineTyped ? 'ref' : 'read'; + if (mode === 'ref' && returnsRoutineType(found.node, context)) mode = 'read'; + } + // Written without arguments, a routine that needs some can only be a + // method pointer — save a constructor, whose name then means an inherited + // one outside the project (`TObject.Create`) — and so is a procedure read + // for a value, and an event's method; any other runs. + const needsArgs = needsArguments(found.node); + if (needsArgs && routineKeyword(found.node, context) === 'constructor') return null; + const pointer = mode === 'ref' || needsArgs || (mode !== 'call' && !yieldsValue(found.node, context)); + // A statement runs its routine, and a receiver is a routine's value. + if (pointer && (mode === 'call' || mode === 'recv')) return null; + edgeKind = pointer ? 'references' : 'calls'; + } context.rememberNode?.(found.node); return { original: ref, @@ -323,8 +350,9 @@ function nameInScope(name: string, cls: Node | null, ref: UnresolvedRef, context * The routine nested in the calling routine, or in one around it, that a * bare name there names (`procedure Inner;` between `procedure TFoo.Bar;` * and its `begin`, `TFoo::Bar::Inner`): the innermost one declared above the - * call, the calling routine itself among them. It comes before anything of - * the class or the unit. Null when none is. + * call, the calling routine itself among them, or declared `forward` above + * it (see declaredForward). It comes before anything of the class or the + * unit. Null when none is. */ function nestedRoutineInScope(lower: string, ref: UnresolvedRef, context: ResolutionContext): Found | null { // Most names no nested routine has: settled before any other lookup. @@ -340,7 +368,8 @@ function nestedRoutineInScope(lower: string, ref: UnresolvedRef, context: Resolu let best: Node | null = null; let depth = -1; for (const n of named) { - if (n.filePath !== caller.filePath || n.startLine > ref.line || !isNestedRoutine(n, context)) continue; + if (n.filePath !== caller.filePath || !isNestedRoutine(n, context)) continue; + if (n.startLine > ref.line && !declaredForward(n, ref.line, context)) continue; const outer = ownerOf(n); // Nested in the caller, or in a routine the caller is nested in. if (chain !== outer && !chain.startsWith(`${outer}::`)) continue; @@ -355,6 +384,31 @@ function nestedRoutineInScope(lower: string, ref: UnresolvedRef, context: Resolu return found; } +/** + * Whether a routine nested in another is declared `forward` above a line + * (`procedure Late; forward;`), which puts it in scope there ahead of its + * body (#2550): a header of its name, as indented as its own, that ends in + * `forward;`, between the line and the header indented less above it, the + * routine both are nested in. + */ +function declaredForward(routine: Node, line: number, context: ResolutionContext): boolean { + const lines = fileLines(routine.filePath, context); + const name = routine.name.toLowerCase(); + for (let i = Math.min(line, lines.length) - 1; i >= 0; i--) { + const m = /^(\s*)(?:class\s+)?(?:procedure|function|constructor|destructor)\s+([A-Za-z_]\w*)/i.exec(lines[i]!); + if (!m) continue; + if (m[1]!.length < routine.startColumn) return false; + if (m[1]!.length !== routine.startColumn || m[2]!.toLowerCase() !== name) continue; + // Its parameters may go on over a few lines. + let text = lines[i]!.replace(/\/\/.*$|\{[^}]*\}|\(\*.*?\*\)/g, ' '); + for (let j = i + 1; j < lines.length && j <= i + 4 && (text.split('(').length > text.split(')').length); j++) { + text += ' ' + lines[j]!.replace(/\/\/.*$|\{[^}]*\}|\(\*.*?\*\)/g, ' '); + } + if (/\bforward\s*;/i.test(text)) return true; + } + return false; +} + /** * Whether a node is a routine nested in another (see nestedRoutineInScope): * a Pascal function qualified under a routine, which no code outside the one @@ -457,36 +511,70 @@ function declarationInScope(lower: string, cls: Node | null, ref: UnresolvedRef, return found; } -/** A dotted name: the method its receiver's declared type has. */ -function memberThroughPath(path: string[], cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): Found | null { - const head = headOf(path[0]!, cls, ref, context); - if (!head) return null; - let type: Node | null; +/** + * A dotted name: the method its receiver's declared type has; with + * `holdsRoutine`, data that holds a routine too (a chain called with its + * arguments, `Owner.Events.FOnChange(Self)`, see isProceduralData). + */ +function memberThroughPath(path: string[], cls: Node | null, ref: UnresolvedRef, context: ResolutionContext, holdsRoutine = false): Found | null { + const last = memberAtPath(path, cls, ref, context); + if (!last) return null; + if (!isRoutine(last.node) && !(holdsRoutine && DATA_KINDS.has(last.node.kind) && isProceduralData(last.node, context))) return null; + return { node: last.node, resolvedBy: last.unit ? 'import' : 'instance-method', confidence: 0.9 }; +} + +/** + * What a dotted name's last link is declared as: a member of what the links + * before it are declared to be — a field's or a property's type, a + * function's result — from its head (see headOf), or, with `unit`, the + * routine or variable a unit's name qualifies (`Utils.Helper`). A constructor + * called on a class gives an instance of it: one the class declares, or + * `Create`, which the project's classes inherit from outside it + * (`TLog.Create.Write('x')`, `Logs.TLog.Create().Write('x')`). + */ +function memberAtPath(path: string[], cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): { node: Node; unit: boolean } | null { + let head = headOf(path[0]!, cls, ref, context); let rest = path.slice(1); + // A dotted unit name, the longest the links make (`mormot.core.os.GetTickCount64`). + for (let k = path.length - 1; !head && k >= 2; k--) { + const unitFile = unitFileNamed(path.slice(0, k).join('.').toLowerCase(), ref.filePath!, context); + if (unitFile) { + head = { type: null, unitFile }; + rest = path.slice(k); + } + } + if (!head) return null; + let type = head.type; + let classRef = head.classRef === true; if (head.unitFile) { - // `UnitName.Routine`, `UnitName.GlobalVar.Method`. + // `UnitName.Routine`, `UnitName.GlobalVar.Method`, `UnitName.TFoo.Create.Method`. const decl = unitDeclaration(head.unitFile, rest[0]!.toLowerCase(), context, ref.filePath!); if (!decl) return null; - if (rest.length === 1) return isRoutine(decl) ? { node: decl, resolvedBy: 'import', confidence: 0.9 } : null; - type = typeOfMember(decl, context); + if (rest.length === 1) return { node: decl, unit: true }; + classRef = CLASS_KINDS.has(decl.kind); + type = classRef ? decl : typeOfMember(decl, context); rest = rest.slice(1); - } else { - type = head.type; } - for (const link of rest.slice(0, -1)) { - const member = type ? memberInHierarchy(type, link.toLowerCase(), context) : null; + for (let i = 0; i < rest.length && type; i++) { + const lower = rest[i]!.toLowerCase(); + const member = memberInHierarchy(type, lower, context); + if (i === rest.length - 1) return member ? { node: member, unit: false } : null; + if (classRef && (member ? routineKeyword(member, context) === 'constructor' : lower === 'create')) { + classRef = false; + continue; + } if (!member) return null; type = typeOfMember(member, context); + classRef = false; } - const member = type ? memberInHierarchy(type, rest[rest.length - 1]!.toLowerCase(), context) : null; - return member && isRoutine(member) ? { node: member, resolvedBy: 'instance-method', confidence: 0.9 } : null; + return null; } /** * What a dotted name's first link is: a value of a known class (a local's - * declared type, written `:TFoo`), a class itself, or a unit. + * declared type, written `:TFoo`), a class itself (`classRef`), or a unit. */ -function headOf(name: string, cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): { type: Node | null; unitFile?: string } | null { +function headOf(name: string, cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): { type: Node | null; classRef?: boolean; unitFile?: string } | null { if (name.startsWith(':')) return { type: classNamed(name.slice(1), ref.filePath!, context) }; const lower = name.toLowerCase(); if (lower === 'self') return cls ? { type: cls } : null; @@ -497,11 +585,36 @@ function headOf(name: string, cls: Node | null, ref: UnresolvedRef, context: Res const decl = ownUnitDeclaration(ref.filePath!, lower, context) ?? usedUnitFiles(ref.filePath!, context).reduceRight( (hit, file) => hit ?? unitDeclaration(file, lower, context, ref.filePath!), undefined); - if (decl) return { type: CLASS_KINDS.has(decl.kind) ? decl : typeOfMember(decl, context) }; + if (decl) return CLASS_KINDS.has(decl.kind) ? { type: decl, classRef: true } : { type: typeOfMember(decl, context) }; const unitFile = unitFileNamed(lower, ref.filePath!, context); return unitFile ? { type: null, unitFile } : null; } +/** + * Whether the target a value is assigned to is declared with a routine type + * (see the file comment): the field, property or variable a name reaches in + * scope, or through a receiver (`FEvents.OnGet`, `Self.Callback`), or the + * declared type of a local (`:TGet`, `:procedure` for one written out). + * Undefined when the declaration, or what its type is, can't be read. + */ +function assignedRoutineType(target: string, cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): boolean | undefined { + const links = target.split('.'); + if (links.length === 1 && links[0]!.startsWith(':')) return routineTypeVerdict(links[0]!.slice(1), context, 0); + const node = links.length === 1 + ? declarationInScope(links[0]!.toLowerCase(), cls, ref, context)?.node + : memberAtPath(links, cls, ref, context)?.node; + if (!node || !DATA_KINDS.has(node.kind) || node.kind === 'enum_member') return undefined; + const text = declaredTypeText(node, context); + return text ? routineTypeVerdict(text, context, 0) : undefined; +} + +/** Whether a function's result is of a routine type (`function MakeHandler: TNotifyEvent`). */ +function returnsRoutineType(routine: Node, context: ResolutionContext): boolean { + if (!isRoutine(routine)) return false; + const typeName = routine.returnType ?? /:\s*([A-Za-z_][\w.]*)\s*;?\s*$/.exec(routine.signature ?? '')?.[1]; + return !!typeName && routineTypeVerdict(typeName, context, 0) === true; +} + // --------------------------------------------------------------------------- // Classes, units and declarations // --------------------------------------------------------------------------- @@ -909,10 +1022,13 @@ function classNamed(typeName: string, fromFile: string, context: ResolutionConte }; let cls = declarationOf(visible(CLASS_KINDS)); if (!cls && depth < 4) { - // A type alias names the class it stands for: `TVTAncestor = TVTAncestorVcl;`. + // A type alias names the class it stands for: `TVTAncestor = TVTAncestorVcl;`, + // and so do a pointer type and a class reference type, whose values reach + // its members (`PVirtualNode = ^TVirtualNode;`, `TSynLogClass = class of + // TSynLog;`, #2550). for (const alias of visible(ALIAS_KINDS)) { const line = (fileLines(alias.filePath, context)[alias.startLine - 1] ?? '').replace(/\/\/.*$|\{[^}]*\}/g, ''); - const target = /=\s*([A-Za-z_][\w.]*)\s*;/.exec(line)?.[1]; + const target = /=\s*(?:\^|class\s+of\b)?\s*([A-Za-z_][\w.]*)\s*;/i.exec(line)?.[1]; if (target && (cls = classNamed(target, alias.filePath, context, depth + 1))) break; } } @@ -1016,14 +1132,36 @@ function isProceduralData(node: Node, context: ResolutionContext): boolean { * and the names Delphi gives them (`TNotifyEvent`, `TWndMethod`). */ function isProceduralTypeText(text: string, context: ResolutionContext, depth: number): boolean { + return routineTypeVerdict(text, context, depth) === true; +} + +/** + * Whether a written type is a routine's (see isProceduralTypeText): false + * for one of the System unit's value types, and undefined when nothing says, + * for a name neither the project declares nor the RTL's names say is a + * routine type (`TStringList`) or text that names no type (`array of TFoo`). + */ +function routineTypeVerdict(text: string, context: ResolutionContext, depth: number): boolean | undefined { if (PROCEDURAL_TYPE.test(text)) return true; const typeName = /^(?:type\s+)?([A-Za-z_][\w.]*)/i.exec(text)?.[1]?.split('.').pop()?.toLowerCase(); - if (!typeName || depth > 3) return false; + if (!typeName || depth > 3) return undefined; const types = typesNamed(typeName, context); - if (types.length === 0) return RTL_PROCEDURAL_TYPES.has(typeName) || /^t\w*(?:event|proc|method|callback)$/.test(typeName); + if (types.length === 0) { + if (RTL_PROCEDURAL_TYPES.has(typeName) || /^t\w*(?:event|proc|method|callback)$/.test(typeName)) return true; + return SYSTEM_VALUE_TYPES.has(typeName) ? false : undefined; + } return types.some((t) => t.kind === 'type_alias' && isProceduralTypeText(aliasedTypeText(t, context), context, depth + 1)); } +/** The System unit's value types, lowercased, which hold no routine. */ +const SYSTEM_VALUE_TYPES: ReadonlySet = new Set([ + 'boolean', 'bytebool', 'wordbool', 'longbool', 'integer', 'cardinal', 'shortint', 'smallint', 'longint', 'longword', + 'int8', 'int16', 'int32', 'int64', 'uint8', 'uint16', 'uint32', 'uint64', 'byte', 'word', 'dword', 'nativeint', + 'nativeuint', 'single', 'double', 'extended', 'real', 'currency', 'comp', 'char', 'ansichar', 'widechar', 'string', + 'ansistring', 'widestring', 'unicodestring', 'shortstring', 'rawbytestring', 'utf8string', 'pchar', 'pansichar', + 'pwidechar', 'pointer', 'variant', 'olevariant', 'tdatetime', 'tdate', 'ttime', +]); + /** * The project's Pascal types a name names, generic ones by the name before * their parameters: `TSetParams` for `TSetParams`.