From 7b50ca832152e9948f568ae641ea34952fac1334 Mon Sep 17 00:00:00 2001 From: Colby Mchenry Date: Thu, 22 Oct 2026 15:20:06 +0000 Subject: [PATCH] fix(pascal): Delphi calls to compiler intrinsics and plain data no longer link namesakes (#2803) A Pascal call to a name the compiler or the System unit gives meaning to (SizeOf, TypeInfo, High, Low, Length, Inc, Dec, Assigned, Ord, Exit, Include, Move, Assert, typecasts like Pointer(P)) went to name matching, which linked any project member of that name: mORMot's TRttiProp.TypeInfo, a record's length or high field, a property named Pointer. The built-in name check compared case, so length(S) and dec(N) got through too. And a call that resolved to a field, property or variable linked whatever data had the name. Now a bare call to a System name links only to a declaration its scope reaches: the class and its ancestors, the unit, the units it uses last first, skipping a unit's stand-in declared under {$IFDEF} or {$IF}. A call resolved to data stands only when the data's declared type is a routine type (written out, a project alias to one, generic or on two lines, or an RTL procedural type by name), retargeted to what the scope declares. A name the calling routine declares itself links nothing; a name the scope doesn't declare at all (a with object's member, a declaration the parse misplaced) links to the one routine-holding field or variable of that name. Built-in names compare without case; the RTL namespaces keep their spelling, except system. Scope lookups now see a unit whose unit header the parser lost, by its file name (its indented, lost class members aren't taken for its routines), and an include file shares its unit's scope and uses clauses. A with body's bare call to a System name is not extracted, since it may be the with object's. Validation, edges removed/added against origin/main: SynEdit -243/+50, HeidiSQL -858/+296, mORMot2 -9039/+987, DelphiMVCFramework -2420/+242, DWScript -705/+222; leveldb and SDWebImage byte-identical. Sampled precision of calls to data, before and after: 20/50 and 50/50; of calls to System names: 2/50 and 47/47. Sampled removed edges: 40/40 wrong. Follow-up to #2514. Co-Authored-By: Claude Opus 5.5 --- CHANGELOG.md | 1 + __tests__/pascal-system-calls.test.ts | 786 ++++++++++++++++++++++ src/extraction/languages/pascal-system.ts | 31 + src/extraction/tree-sitter.ts | 7 +- src/resolution/index.ts | 38 +- src/resolution/pascal-scope.ts | 610 +++++++++++++++-- 6 files changed, 1409 insertions(+), 64 deletions(-) create mode 100644 __tests__/pascal-system-calls.test.ts create mode 100644 src/extraction/languages/pascal-system.ts diff --git a/CHANGELOG.md b/CHANGELOG.md index 4e2fecdc1..5afe0259c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -31,6 +31,7 @@ and adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). - In Delphi, a `for … in` loop that declares its variable inline, like `for var lItem in AList do` or `for var lHandle: THandle in lHandles do`, now has its calls indexed, and a call on a typed loop variable reaches that type's method. Before, the whole loop was skipped, so a routine calling a method only from such a loop was missing from that method's callers. Thanks @stalexteam for the report. (#2546) - In Delphi, a call made on the result of another call, like `MD5FileSized(TMeta.ExtendedPath(APath)).IsSame(AKey)` or `List[IndexOf(Name)].Free`, now has the inner calls indexed too, so `MD5FileSized` and `TMeta.ExtendedPath` list that routine among their callers. A typecast like `TButton(Sender).Caption` or `F := TFoo(Obj)` now counts as a use of the type instead of creating one. Thanks @stalexteam for the report. (#2547) - 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 @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 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. - In VB.NET, a field or property initializer like `= Compute()` or `As New List(Of Order)` now links what it calls and creates, and so do a `Custom Event`'s `AddHandler`, `RemoveHandler` and `RaiseEvent` blocks. Re-index VB.NET and C# projects after upgrading. - In C#, a field or property initializer like `private readonly ILogger _log = LogManager.GetLogger(typeof(X));` or `public List Items { get; } = new();` now links what it calls, creates and reads, including inside a lambda, and a target-typed `new()` there counts as creating the declared type. Before, initializers were skipped, so a method or class used only from one — like a converter created in a static list — looked unused, and a method passed as a value there was credited to the whole class instead of the field or property. diff --git a/__tests__/pascal-system-calls.test.ts b/__tests__/pascal-system-calls.test.ts new file mode 100644 index 000000000..b26e43c24 --- /dev/null +++ b/__tests__/pascal-system-calls.test.ts @@ -0,0 +1,786 @@ +/** + * A Pascal call to a name the compiler or the System unit gives meaning to, + * like `SizeOf`, `TypeInfo`, `High`, `Inc`, `Move` or a typecast to a built-in + * type such as `Pointer(P)`, linked to any project member of that name, and + * the check that should have stopped it compared case: Pascal ignores it, so + * `length(S)` and `dec(N)` went to a record's `length` field and a variable + * named `dec`. A call that resolved to a field, a property or a variable + * linked too, though only one holding a routine can run. Now such a call + * links only to a declaration its scope reaches: a member of the class + * (`Delete(I)` in a list class), or a routine of the unit or the units it + * uses, and data only when its declared type is a routine's. That scope + * takes in the include files a unit pulls in and the units whose header the + * parser lost, and stops at the calling routine's own parameters and locals. + */ +import { describe, it, expect, beforeAll } from 'vitest'; +import * as fs from 'node:fs'; +import * as path from 'node:path'; +import * as os from 'node:os'; +import { CodeGraph } from '../src'; +import { initGrammars, loadGrammarsForLanguages } from '../src/extraction/grammars'; + +beforeAll(async () => { + await initGrammars(); + await loadGrammarsForLanguages(['pascal']); +}); + +async function withIndex(files: Record, check: (cg: CodeGraph) => void): Promise { + const dir = fs.mkdtempSync(path.join(os.tmpdir(), 'cg-pascal-system-')); + try { + for (const [name, code] of Object.entries(files)) fs.writeFileSync(path.join(dir, name), code); + const cg = await CodeGraph.init(dir, { index: true }); + try { + check(cg); + } finally { + cg.close(); + } + } finally { + fs.rmSync(dir, { recursive: true, force: true }); + } +} + +/** The calls a routine makes, as `line: Target::Name`. */ +function callsFrom(cg: CodeGraph, qualifiedName: string): string[] { + const source = cg.getNodesByKind('method').concat(cg.getNodesByKind('function')).find((n) => n.qualifiedName === qualifiedName); + expect(source, qualifiedName).toBeDefined(); + return cg + .getOutgoingEdges(source!.id) + .filter((e) => e.kind === 'calls') + .map((e) => `${e.line}: ${cg.getNode(e.target)?.qualifiedName ?? '?'}`) + .sort(); +} + +// Namesakes of the System unit's names, elsewhere in the project. +const LIB = `unit Lib; + +interface + +type + TRec = record + length: Integer; + high: Integer; + end; + + TOther = class + private + FObj: TObject; + public + function TypeInfo: Pointer; + procedure Move(A, B: Integer); + function SizeOf: Integer; + property Pointer: TObject read FObj; + end; + +var + dec: Integer; + +implementation + +function TOther.TypeInfo: Pointer; begin Result := nil; end; +procedure TOther.Move(A, B: Integer); begin end; +function TOther.SizeOf: Integer; begin Result := 0; end; + +end. +`; + +describe('Pascal calls to the System unit and to data', () => { + it('links an intrinsic, a System routine or a built-in typecast to no project namesake, whatever its case', async () => { + const main = `unit Main; + +interface + +uses Lib; + +type + TList2 = class + public + procedure Run(const S: string; var A: array of Integer); + end; + +implementation + +procedure TList2.Run(const S: string; var A: array of Integer); +var + P: Pointer; + N: Integer; +begin + N := length(S) + High(A) + SIZEOF(N); + dec(N); + P := TypeInfo(TList2); + Move(P, P, 0); + P := Pointer(Self); +end; + +end. +`; + await withIndex({ 'Lib.pas': LIB, 'Main.pas': main }, (cg) => { + expect(callsFrom(cg, 'TList2::Run')).toEqual([]); + }); + }); + + it('takes `system.` for the System unit whatever its case, and a lowercase `data.` for a variable', async () => { + const main = `unit Main; + +interface + +uses Lib; + +type + TStore = class + public + function GetObjectFrom(const Name: string): TObject; + end; + +procedure Run(data: TStore); + +implementation + +function TStore.GetObjectFrom(const Name: string): TObject; begin Result := nil; end; + +procedure Run(data: TStore); +var + P: Pointer; +begin + P := system.TypeInfo(TStore); + data.GetObjectFrom('setting'); +end; + +end. +`; + await withIndex({ 'Lib.pas': LIB, 'Main.pas': main }, (cg) => { + expect(callsFrom(cg, 'Run')).toEqual(['24: TStore::GetObjectFrom']); + }); + }); + + it('links one to the declaration that shadows it in the call\'s scope', async () => { + const main = `unit Main; + +interface + +uses Lib; + +type + TList2 = class + public + procedure Delete(Index: Integer); + procedure Clear; + end; + +function Length(const S: string): Integer; +procedure Tidy; + +implementation + +function Length(const S: string): Integer; begin Result := 0; end; + +procedure TList2.Delete(Index: Integer); begin end; + +procedure TList2.Clear; +begin + Delete(0); +end; + +procedure Tidy; +begin + Length('x'); +end; + +end. +`; + await withIndex({ 'Lib.pas': LIB, 'Main.pas': main }, (cg) => { + // The list's own `Delete`, and the unit's own `Length`. + expect(callsFrom(cg, 'TList2::Clear')).toEqual(['25: TList2::Delete']); + expect(callsFrom(cg, 'Tidy')).toEqual(['30: Length']); + }); + }); + + it('takes a unit\'s stand-in declared under a condition for the System unit\'s own', async () => { + const lib = `unit Lib; + +interface + +type +{$IFNDEF UNICODE} + UnicodeString = WideString; +{$ENDIF} + RawUtf8 = type AnsiString; + +{$IFNDEF COMPILER_3_UP} +procedure Assert(Expr: Boolean); { stub for Delphi 2 } +{$ENDIF} +function UpperCase(const S: RawUtf8): RawUtf8; + +implementation + +{$IFNDEF COMPILER_3_UP} +procedure Assert(Expr: Boolean); begin end; +{$ENDIF} +function UpperCase(const S: RawUtf8): RawUtf8; begin Result := S; end; + +end. +`; + const main = `unit Main; + +interface + +uses SysUtils, Lib; + +procedure Run(P: Pointer; const S: RawUtf8); + +implementation + +procedure Run(P: Pointer; const S: RawUtf8); +begin + Assert(P <> nil); + if UnicodeString(P) <> '' then + UpperCase(S); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + // The used unit's `UpperCase` hides SysUtils' one; `Assert` and + // `UnicodeString` are the compiler's. + expect(callsFrom(cg, 'Run')).toEqual(['15: UpperCase']); + const run = cg.getNodesByKind('function').find((n) => n.qualifiedName === 'Run')!; + expect(cg.getOutgoingEdges(run.id).filter((e) => e.kind === 'references').map((e) => cg.getNode(e.target)?.name)) + .not.toContain('UnicodeString'); + }); + }); + + it('reaches a class\'s ancestor through a type alias', async () => { + const base = `unit Base; + +interface + +type + TSearchEvent = procedure(Sender: TObject; const Text: string) of object; + + TBaseTree = class + private + FOnSearch: TSearchEvent; + public + function Ready: Boolean; + property OnSearch: TSearchEvent read FOnSearch write FOnSearch; + end; + +implementation + +function TBaseTree.Ready: Boolean; begin Result := True; end; + +end. +`; + const main = `unit Main; + +interface + +uses Base; + +type + TAncestor = TBaseTree; + + TStringTree = class(TAncestor) + public + procedure Search(const Text: string); + end; + +implementation + +procedure TStringTree.Search(const Text: string); +begin + if Ready then + OnSearch(Self, Text); +end; + +end. +`; + await withIndex({ 'Base.pas': base, 'Main.pas': main }, (cg) => { + const search = cg.getNodesByKind('method').find((n) => n.qualifiedName === 'TStringTree::Search')!; + const targets = cg.getOutgoingEdges(search.id).filter((e) => e.kind === 'calls') + .map((e) => cg.getNode(e.target)?.qualifiedName).sort(); + // `TAncestor = TBaseTree;` names the class the tree descends from: its + // `Ready` runs, and so does what its `OnSearch` event holds. + expect(targets).toEqual(['TBaseTree::OnSearch', 'TBaseTree::Ready']); + }); + }); + + it('links a name its scope doesn\'t declare to the one routine-holding field of that name, unless the routine declares it', async () => { + const lib = `unit Lib; + +interface + +type + THandleAlloc = function(Parent: Pointer; var Handle: Pointer): Integer; + THasher = function(Crc: Cardinal; Buf: Pointer; Len: Cardinal): Cardinal; + + TOciLib = class + public + HandleAlloc: THandleAlloc; + end; + + TDynHasher = class + private + FHasher: THasher; + public + property Hasher: THasher read FHasher; + property Direct: THasher read FHasher; + end; + +implementation + +end. +`; + const main = `unit Main; + +interface + +uses Lib; + +type + TConn = class + private + FOci: TOciLib; + FEnv: Pointer; + public + procedure Connect; + end; + +function Hash(Item: Pointer; Hasher: THasher): Cardinal; +procedure Test; + +implementation + +procedure TConn.Connect; +begin + with FOci do + HandleAlloc(nil, FEnv); +end; + +function Hash(Item: Pointer; Hasher: THasher): Cardinal; +begin + Result := Hasher(0, Item, 4); +end; + +procedure Test; + + procedure Direct(const Url: string); + begin + end; + +begin + Direct('/root'); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + // The `with` object's member, which the class's scope doesn't hold. + expect(callsFrom(cg, 'TConn::Connect')).toEqual(['24: TOciLib::HandleAlloc']); + // A parameter and a nested routine, not the properties named so. + expect(callsFrom(cg, 'Hash')).toEqual([]); + expect(callsFrom(cg, 'Test')).toEqual([]); + }); + }); + + it('takes a parameter or a local of the calling routine for what its name calls', async () => { + const lib = `unit Lib; + +interface + +type + TLoad = procedure(Data: Pointer); + +var + load: TLoad; + +implementation + +end. +`; + const main = `unit Main; + +interface + +uses Classes, Lib; + +type + TFoo = class + private + FOnChange: TNotifyEvent; + public + procedure Fire(OnChange: TNotifyEvent); + procedure Run(Data: Pointer); + property OnChange: TNotifyEvent read FOnChange; + end; + +implementation + +procedure TFoo.Fire(OnChange: TNotifyEvent); +begin + OnChange(Self); +end; + +procedure TFoo.Run(Data: Pointer); +var + load: TLoad; +begin + load := nil; + load(Data); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + expect(callsFrom(cg, 'TFoo::Fire')).toEqual([]); + expect(callsFrom(cg, 'TFoo::Run')).toEqual([]); + }); + }); + + it('reads a routine type declared on two lines, generic, or as an alias of another', async () => { + const main = `unit Main; + +interface + +uses SysUtils; + +type + THelperEvent = + procedure(const Value: Variant) of object; + TSetParams = reference to procedure(const Obj: T); + TFormatter = TFunc; + TCounter = Integer; + TCount = TCounter; + + TWriter = class + private + FOnHelp: THelperEvent; + FSetParams: TSetParams; + FFormatter: TFormatter; + FCount: TCount; + public + procedure Write(Obj: T; E: Exception); + end; + +implementation + +procedure TWriter.Write(Obj: T; E: Exception); +begin + FOnHelp(1); + FSetParams(Obj); + FFormatter(E); + FCount(1); +end; + +end. +`; + await withIndex({ 'Main.pas': main }, (cg) => { + expect(callsFrom(cg, 'TWriter::Write')).toEqual([ + '29: TWriter::FOnHelp', + '30: TWriter::FSetParams', + '31: TWriter::FFormatter', + ]); + }); + }); + + it('sees the declarations of a used unit whose header the parser lost', async () => { + // The `{$IFDEF}` around a local `var` section costs the parse its `unit` + // node; the unit is still the one its file is named after. + const lib = `unit Lib; + +interface + +type + THasher = function(Crc: Cardinal; Buf: Pointer; Len: Cardinal): Cardinal; + +var + crc32c: THasher; + +function FileSize(const FileName: string): Int64; + +implementation + +function FileSize(const FileName: string): Int64; +{$IFDEF MSWINDOWS} +var + Handle: THandle; +{$ENDIF} +begin + Result := 0; +end; + +end. +`; + const main = `unit Main; + +interface + +uses Lib; + +procedure Run(const Name: string); + +implementation + +procedure Run(const Name: string); +begin + if FileSize(Name) > 0 then + crc32c(0, nil, 0); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + expect(cg.getNodesByKind('module').map((n) => n.name)).toEqual(['Main']); + expect(callsFrom(cg, 'Run')).toEqual(['13: FileSize', '14: crc32c']); + }); + }); + + it('gives an include file\'s code the scope of the unit that includes it', async () => { + const hash = `unit Hash; + +interface + +type + THasher = function(Crc: Cardinal; Buf: Pointer; Len: Cardinal): Cardinal; + +var + DefaultHasher: THasher; + +implementation + +end. +`; + const os = `unit Os; + +interface + +uses Hash; + +procedure Entropy; +procedure Init; + +implementation + +{$I Os.windows.inc} + +procedure Init; +begin + OsLog('init'); +end; + +end. +`; + const extra = `unit Extra; + +interface + +var + ExtraLog: procedure(const S: string); + +implementation + +end. +`; + // An include file may open with a `uses` clause of its own. + const inc = `uses + Extra; + +var + OsLog: procedure(const S: string); + +procedure Entropy; +var + Seed: Cardinal; +begin + Seed := DefaultHasher(0, nil, 0); + ExtraLog('seeded'); +end; +`; + await withIndex({ 'Hash.pas': hash, 'Extra.pas': extra, 'Os.pas': os, 'Os.windows.inc': inc }, (cg) => { + const entropy = cg.getNodesByKind('function').find((n) => n.name === 'Entropy' && n.filePath.endsWith('.inc')); + expect(entropy).toBeDefined(); + expect(cg.getOutgoingEdges(entropy!.id).filter((e) => e.kind === 'calls').map((e) => cg.getNode(e.target)?.qualifiedName).sort()) + .toEqual(['DefaultHasher', 'ExtraLog']); + // And the unit's own code sees what its include file declares. + expect(callsFrom(cg, 'Init')).toEqual(['16: OsLog']); + }); + }); + + it('takes no member of a class such a unit\'s parse lost for a routine of the unit', async () => { + // The anonymous record ends the class early, so `Insert` comes out as a + // routine of the unit, indented as no routine of the unit is. + const lib = `unit Lib; + +interface + +type + TClient = class + Items: array of record + Name: string; + end; + procedure Insert(Index: Integer; const S: string); + end; + +procedure Log(const S: string); + +implementation + +procedure TClient.Insert(Index: Integer; const S: string); begin end; + +procedure Log(const S: string); +{$IFDEF MSWINDOWS} +var + Handle: THandle; +{$ENDIF} +begin +end; + +end. +`; + const main = `unit Main; + +interface + +uses Lib; + +procedure Run(var S: string); + +implementation + +procedure Run(var S: string); +begin + Insert('x', S, 1); + Log(S); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + const insert = cg.getNodesByKind('function').find((n) => n.name === 'Insert'); + expect(insert?.startColumn).toBe(4); + expect(callsFrom(cg, 'Run')).toEqual(['14: Log']); + }); + }); + + it('leaves out such a call in a `with` body, which may be the `with` object\'s', async () => { + const main = `unit Main; + +interface + +type + TItem = class + public + procedure Delete(Index: Integer); + end; + + TItems = class + public + function Add: TItem; + procedure Delete(Index: Integer); + procedure Assign(Source: TObject); + end; + +implementation + +procedure TItem.Delete(Index: Integer); begin end; +function TItems.Add: TItem; begin Result := nil; end; +procedure TItems.Delete(Index: Integer); begin end; + +procedure TItems.Assign(Source: TObject); +begin + with Add do + Delete(0); + Delete(1); +end; + +end. +`; + await withIndex({ 'Main.pas': main }, (cg) => { + // In the `with` body, `Delete` is the item's, not the list's; after it, the list's. + expect(callsFrom(cg, 'TItems::Assign')).toEqual(['28: TItems::Delete']); + }); + }); + + it('links a call to data only when the data holds a routine and the call\'s scope reaches it', async () => { + const lib = `unit Lib; + +interface + +type + TNotifyEvent = procedure(Sender: TObject) of object; + + TStranger = class + private + FOnChange: TNotifyEvent; + end; + +implementation + +end. +`; + const main = `unit Main; + +interface + +uses Lib; + +type + TList2 = class + private + FOnChange: TNotifyEvent; + FCount: Integer; + FProc: procedure of object; + FGetter: reference to function: Integer; + FOnLoad, // a list's type comes at its end + FOnSave: TNotifyEvent; + public + procedure Run; + procedure Other; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TOtherList = class + public + procedure Fire; + end; + +var + GLog: procedure(const Msg: string); + GCount: Integer; + +implementation + +procedure TList2.Run; +begin + FOnChange(Self); + OnChange(Self); + FProc(); + FGetter(); + GLog('x'); + FCount(1); + GCount(1); + FOnLoad(Self); +end; + +procedure TList2.Other; begin end; + +procedure TOtherList.Fire; +begin + FOnChange(Self); +end; + +end. +`; + await withIndex({ 'Lib.pas': lib, 'Main.pas': main }, (cg) => { + expect(callsFrom(cg, 'TList2::Run')).toEqual([ + '35: TList2::FOnChange', + '36: TList2::OnChange', + '37: TList2::FProc', + '38: TList2::FGetter', + '39: GLog', + '42: TList2::FOnLoad', + ]); + // No class this method's scope reaches declares `FOnChange`. + expect(callsFrom(cg, 'TOtherList::Fire')).toEqual([]); + }); + }); +}); diff --git a/src/extraction/languages/pascal-system.ts b/src/extraction/languages/pascal-system.ts new file mode 100644 index 000000000..14daeabb0 --- /dev/null +++ b/src/extraction/languages/pascal-system.ts @@ -0,0 +1,31 @@ +/** + * The names Delphi's compiler and System unit give meaning to, lowercased: + * intrinsics (`SizeOf`, `TypeInfo`, `High`, `Inc`, `Assigned`, `Exit`), the + * System and SysUtils routines everyone calls (`Move`, `FillChar`, `Copy`, + * `Format`, `WriteLn`), and the built-in types a typecast names (`Pointer(P)`, + * `Integer(X)`). Pascal names ignore case: `length(S)` is `Length(S)`. A call + * to one is the System unit's unless a declaration in its scope shadows it + * (see resolution/pascal-scope). + */ +export const PASCAL_SYSTEM_NAMES: ReadonlySet = new Set([ + // Intrinsics and System routines + 'abs', 'addr', 'arctan', 'assert', 'assigned', 'assignfile', 'atomiccmpexchange', 'atomicdecrement', + 'atomicexchange', 'atomicincrement', 'blockread', 'blockwrite', 'break', 'chdir', 'chr', 'closefile', 'concat', + 'continue', 'copy', 'cos', 'dec', 'default', 'delete', 'dispose', 'eof', 'eoln', 'exclude', 'exit', 'exp', + 'fail', 'filepos', 'filesize', 'fillchar', 'finalize', 'frac', 'freemem', 'getdir', 'getmem', 'gettypekind', + 'halt', 'hasweakref', 'hi', 'high', 'inc', 'include', 'initialize', 'insert', 'int', 'ioresult', + 'isconstvalue', 'ismanagedtype', 'length', 'ln', 'lo', 'low', 'mkdir', 'move', 'new', 'odd', 'ord', + 'paramcount', 'paramstr', 'pi', 'pred', 'ptr', 'random', 'randomize', 'read', 'readln', 'reallocmem', + 'returnaddress', 'rmdir', 'round', 'runerror', 'setlength', 'setstring', 'sin', 'sizeof', 'slice', 'sqr', + 'sqrt', 'str', 'succ', 'swap', 'trunc', 'typehandle', 'typeinfo', 'typeof', 'uniquestring', 'upcase', 'val', + 'vararrayredim', 'write', 'writeln', + // SysUtils routines the resolver has always taken for the RTL's + 'abort', 'date', 'datetostr', 'floattostr', 'format', 'freeandnil', 'inttostr', 'lowercase', 'now', 'pos', + 'strtodate', 'strtofloat', 'strtoint', 'time', 'trim', 'uppercase', + // Built-in types, called as typecasts + 'ansichar', 'ansistring', 'boolean', 'byte', 'bytebool', 'cardinal', 'char', 'comp', 'currency', 'double', + 'extended', 'int16', 'int32', 'int64', 'int8', 'integer', 'longbool', 'longint', 'longword', 'nativeint', + 'nativeuint', 'olevariant', 'pansichar', 'pchar', 'pointer', 'pwidechar', 'rawbytestring', 'real', + 'shortint', 'shortstring', 'single', 'smallint', 'string', 'uint16', 'uint32', 'uint64', 'uint8', + 'unicodestring', 'utf8string', 'variant', 'widechar', 'widestring', 'word', 'wordbool', +]); diff --git a/src/extraction/tree-sitter.ts b/src/extraction/tree-sitter.ts index fb9ae9ef0..95c39a0e7 100644 --- a/src/extraction/tree-sitter.ts +++ b/src/extraction/tree-sitter.ts @@ -32,6 +32,7 @@ import { RazorExtractor } from './razor-extractor'; import { SvelteExtractor } from './svelte-extractor'; import { AstroExtractor } from './astro-extractor'; import { DfmExtractor } from './dfm-extractor'; +import { PASCAL_SYSTEM_NAMES } from './languages/pascal-system'; import { VueExtractor } from './vue-extractor'; import { MyBatisExtractor } from './mybatis-extractor'; import { CfmlExtractor } from './cfml-extractor'; @@ -8834,7 +8835,11 @@ export class TreeSitterExtractor { } const vagueLink = receiverLink && firstChild.type === 'exprDot' && !calleeName.includes('.'); - if (calleeName && !vagueLink) { + // In a `with` body a bare `Delete(I)` or `Assign(X)` may be the `with` + // object's member rather than the System unit's or the class's: which one + // the object's type would have to say (see resolution/pascal-scope). + const withMember = this.pascalWithDepth > 0 && firstChild.type === 'identifier' && PASCAL_SYSTEM_NAMES.has(calleeName.toLowerCase()); + if (calleeName && !vagueLink && !withMember) { this.unresolvedReferences.push({ fromNodeId: callerId, referenceName: calleeName, diff --git a/src/resolution/index.ts b/src/resolution/index.ts index 33d9eb2ca..b088bef40 100644 --- a/src/resolution/index.ts +++ b/src/resolution/index.ts @@ -28,7 +28,9 @@ import { isCppSupertypeRef, matchCppSupertype, clearCppSupertypeMemos } from './ import { gateSwiftTypeTarget, clearSwiftTypeVisibility, swiftExtendedConformances } from './swift-type-visibility'; import { clearDartLibraryMemos } from './dart-libraries'; import { clearVbnetReceiverMemos, isVbMemberRead, isVbPathCall, matchVbMemberRead, matchVbPathCall } from './vbnet-receivers'; -import { clearPascalScopeMemos, isPascalParenlessRef, matchPascalParenlessRef } from './pascal-scope'; +import { + clearPascalScopeMemos, gatePascalDataCall, isPascalParenlessRef, isPascalSystemCall, matchPascalParenlessRef, matchPascalSystemCall, +} from './pascal-scope'; import { gateTypeParameter, clearTypeParameterMemos } from './type-parameters'; import { gateDartLocal, clearDartLocalScopeMemos } from './dart-local-scope'; import { clearCppTypeAliasMemos } from './cpp-type-aliases'; @@ -161,12 +163,18 @@ const PASCAL_CAST_TARGET_KINDS: ReadonlySet = new Set(['class', 'struct' /** The values a TypeScript type may share its name with in its file, which a call or `new` of the name means. */ const TYPE_COMPANION_VALUE_KINDS: ReadonlySet = new Set(['function', 'class', 'component', 'constant', 'variable']); +/** + * The RTL's unit namespaces, as it spells them. Spelled otherwise, a + * receiver is most likely a variable that hides one (`data.GetObjectFrom`, + * `rest.EngineAdd`); only `system.` is the System unit's in any case. + */ const PASCAL_UNIT_PREFIXES = [ 'System.', 'Winapi.', 'Vcl.', 'Fmx.', 'Data.', 'Datasnap.', 'Soap.', 'Xml.', 'Web.', 'REST.', 'FireDAC.', 'IBX.', 'IdHTTP', 'IdTCP', 'IdSSL', ]; +/** Lowercased: Pascal names ignore case. */ const PASCAL_BUILT_INS = new Set([ 'System', 'SysUtils', 'Classes', 'Types', 'Variants', 'StrUtils', 'Math', 'DateUtils', 'IOUtils', 'Generics.Collections', 'Generics.Defaults', @@ -185,7 +193,7 @@ const PASCAL_BUILT_INS = new Set([ 'TList', 'TStringList', 'TStrings', 'TStream', 'TMemoryStream', 'TFileStream', 'Exception', 'EAbort', 'EConvertError', 'EAccessViolation', 'IInterface', 'IUnknown', -]); +].map((name) => name.toLowerCase())); const C_BUILT_INS = new Set([ // Standard C library functions @@ -1416,19 +1424,23 @@ export class ReferenceResolver { !reachesAmbientModule(ref, specifier!, declaringFile, this.context)) return null; } if (!resolved || ref.referenceKind !== 'calls') return resolved; + // A Pascal call to data runs only a routine the data holds, in scope (see + // gatePascalDataCall). + const call = ref.language === 'pascal' ? gatePascalDataCall(resolved, ref, this.context) : resolved; + if (!call) return null; - const target = this.nodeById(resolved.targetNodeId); - if (!target) return resolved; + const target = this.nodeById(call.targetNodeId); + if (!target) return call; const dot = ref.referenceName.lastIndexOf('.'); const memberName = dot >= 0 ? ref.referenceName.slice(dot + 1) : null; const forwarded = resolveAliasBinding(target, memberName, this.context); - if (!forwarded || forwarded.id === resolved.targetNodeId) return resolved; + if (!forwarded || forwarded.id === call.targetNodeId) return call; return this.gateLanguage({ - ...resolved, + ...call, targetNodeId: forwarded.id, - confidence: Math.min(resolved.confidence, 0.85), + confidence: Math.min(call.confidence, 0.85), }, ref); } @@ -1446,6 +1458,10 @@ export class ReferenceResolver { // routine its scope reaches, or through a receiver to a method of the // receiver's declared type; data of that name links nothing. if (isPascalParenlessRef(ref)) return matchPascalParenlessRef(ref, this.context); + // So does a Pascal call to a name the compiler or the System unit gives + // meaning to (`SizeOf`, `TypeInfo`, `length(S)`, `Pointer(P)`), whatever + // its case: only a declaration in the call's scope shadows it. + if (isPascalSystemCall(ref, this.context)) return matchPascalSystemCall(ref, this.context); // A Dart member read (`x.area`) links the getter the receiver's type // reaches, as a call, or nothing — never a guess by name (#2338). if (isDartMemberRead(ref)) return matchDartMemberRead(ref, this.context); @@ -3281,12 +3297,14 @@ export class ReferenceResolver { } } - // Pascal/Delphi built-ins and standard library units + // Pascal/Delphi built-ins, whatever their case: Pascal names ignore it + // (`length(S)`, `system.TypeInfo(T)`). And standard library units. if (ref.language === 'pascal') { - if (PASCAL_UNIT_PREFIXES.some((p) => name.startsWith(p))) { + const lower = name.toLowerCase(); + if (PASCAL_UNIT_PREFIXES.some((p) => name.startsWith(p)) || lower.startsWith('system.')) { return true; } - if (PASCAL_BUILT_INS.has(name)) { + if (PASCAL_BUILT_INS.has(lower)) { return true; } } diff --git a/src/resolution/pascal-scope.ts b/src/resolution/pascal-scope.ts index ec04b11b8..a128a0c94 100644 --- a/src/resolution/pascal-scope.ts +++ b/src/resolution/pascal-scope.ts @@ -34,6 +34,7 @@ import type { Node } from '../types'; 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'; interface Found { @@ -50,6 +51,15 @@ const UNIT_KINDS: ReadonlySet = new Set([ ]); /** What a class declares as its members. */ const MEMBER_KINDS: ReadonlySet = new Set(['method', 'field', 'property', 'constant', 'variable']); +/** Declarations that hold a value rather than run code. */ +const DATA_KINDS: ReadonlySet = new Set(['field', 'property', 'variable', 'constant', 'enum_member']); +/** + * The RTL's routine types whose names don't say so (`TProc`, `TFunc`), + * lowercased; the project's own are read from their declarations. + */ +const RTL_PROCEDURAL_TYPES: ReadonlySet = new Set([ + 'tproc', 'tfunc', 'tpredicate', 'tcomparison', 'tthreadprocedure', 'tlistsortcompare', 'tstringlistsortcompare', +]); const MAX_HIERARCHY_DEPTH = 8; /** Whether `ref` is a paren-less Pascal name (see the file comment), which only this module resolves. */ @@ -97,6 +107,194 @@ export function matchPascalParenlessRef(ref: UnresolvedRef, context: ResolutionC }; } +/** Whether `ref` is a bare Pascal call to one of the System unit's names (see PASCAL_SYSTEM_NAMES). */ +export function isPascalSystemCall(ref: UnresolvedRef, context: ResolutionContext): boolean { + return ref.language === 'pascal' && ref.referenceKind === 'calls' && PASCAL_SYSTEM_NAMES.has(ref.referenceName.toLowerCase()) && + isBareCall(ref, context); +} + +/** + * Whether a Pascal call named by a bare name is written bare: its expression + * starts with the name (`Reset(F)`). The last call of a chain is named bare + * too (`Reset` in `GetKey(P).Reset`), and its scope is its receiver's type. + */ +function isBareCall(ref: UnresolvedRef, context: ResolutionContext): boolean { + if (!/^[A-Za-z_]\w*$/.test(ref.referenceName)) return false; + const line = fileLines(ref.filePath!, context)[ref.line - 1] ?? ''; + return /^[A-Za-z_]\w*/.exec(line.slice(ref.column ?? 0))?.[0].toLowerCase() === ref.referenceName.toLowerCase(); +} + +/** + * A call to one of the System unit's names is the System unit's, which the + * project doesn't hold, unless a declaration in the call's scope shadows it: + * a member of the class (`Delete(I)` in a list class), a routine of the unit + * or the units it uses. A project type of that name is a typecast. Data of + * that name runs only when it holds a routine (see isProceduralData). A unit + * that declares one under a condition stands in for compilers without it + * (`{$IFNDEF UNICODE} UnicodeString = WideString; {$ENDIF}`): the code is + * most likely built with one that has it. + */ +export function matchPascalSystemCall(ref: UnresolvedRef, context: ResolutionContext): ResolvedRef | null { + const decl = declarationInScope(ref.referenceName.toLowerCase(), classOfCall(ref, context), ref, context); + if (!decl) return null; + if (DATA_KINDS.has(decl.node.kind) && !isProceduralData(decl.node, context)) return null; + if (!decl.node.qualifiedName.includes('::') && declaredUnderCondition(decl.node, context)) return null; + context.rememberNode?.(decl.node); + return { original: ref, targetNodeId: decl.node.id, confidence: decl.confidence, resolvedBy: decl.resolvedBy }; +} + +/** + * A Pascal call another strategy resolved to data — a field, a property, a + * variable, a constant — runs what the data holds, so it stands only for data + * whose declared type is a routine's. A bare name is what its scope declares + * (`FOnChange(Self)` in the class that declares its own `FOnChange`): the + * routine or the routine-holding data there, whichever namesake the strategy + * chose. Any other is a namesake: `length(S)` was a record's `length` field, + * `Pointer(P)` a property named `Pointer`. A name the calling routine + * declares itself, as a parameter, a local or a nested routine, is that + * declaration, which the graph doesn't hold. A name its scope doesn't + * declare at all is a `with` object's member (`with OCI do HandleAlloc(...)`) + * or a declaration the parse put in the wrong place: it stands for the one + * routine-holding field or variable the project declares by that name. + */ +export function gatePascalDataCall(result: ResolvedRef, ref: UnresolvedRef, context: ResolutionContext): ResolvedRef | null { + const target = context.getNodeById?.(result.targetNodeId); + if (!target || !DATA_KINDS.has(target.kind)) return result; + if (!isBareCall(ref, context)) return target.language === 'pascal' && isProceduralData(target, context) ? result : null; + const lower = ref.referenceName.toLowerCase(); + if (declaredInRoutine(lower, ref, context)) return null; + const decl = declarationInScope(lower, classOfCall(ref, context), ref, context); + if (!decl) { + const only = target.language === 'pascal' && pascalNamed(lower, context).every((n) => n.id === target.id || n.kind === 'import'); + return only && isProceduralData(target, context) ? result : null; + } + if (!isRoutine(decl.node) && !(DATA_KINDS.has(decl.node.kind) && isProceduralData(decl.node, context))) return null; + if (decl.node.id === target.id) return result; + context.rememberNode?.(decl.node); + return { ...result, targetNodeId: decl.node.id, confidence: decl.confidence, resolvedBy: decl.resolvedBy }; +} + +/** + * Whether the routine making a call declares the called name itself, as a + * parameter, a local or a nested routine (`function Hash(Item: Pointer; + * Hasher: THasher)` calling `Hasher(0, Item, 4)`): from the routine's header + * down to the call. + */ +function declaredInRoutine(lower: string, ref: UnresolvedRef, context: ResolutionContext): boolean { + const lines = fileLines(ref.filePath!, context); + // The header in the text: a method's node may start at its declaration in + // the class, above the fields and the unit's variables. + const from = routineHeaderAt(ref.filePath!, ref.line, context); + const name = escapeRegExp(lower); + const mentions = new RegExp(`\\b${name}\\b`, 'i'); + const declares = new RegExp(`\\b(?:procedure|function)\\s+${name}\\b|\\b${name}\\s*(?:,\\s*[A-Za-z_]\\w*\\s*)*:(?!=)`, 'i'); + for (let i = Math.max(1, from); i <= ref.line && i <= lines.length; i++) { + const text = lines[i - 1]!; + if (mentions.test(text) && declares.test(text.replace(/\/\/.*$|\{[^}]*\}|'[^']*'/g, ' '))) return true; + } + return false; +} + +/** The line of the nearest routine header at column 0 at or above a line, else the line itself. */ +function routineHeaderAt(filePath: string, line: number, context: ResolutionContext): number { + headerClassAt(filePath, line, context); + const headers = memos(context).headerClasses.get(filePath) ?? []; + let found = line; + for (const h of headers) { + if (h.line > line) break; + if (h.routine) found = h.line; + } + return found; +} + +/** + * Whether a declaration is inside an `{$IFDEF}`, `{$IFNDEF}`, `{$IF}` or + * `{$IFOPT}` block, or its `{$ELSE}`. + */ +function declaredUnderCondition(node: Node, context: ResolutionContext): boolean { + const memo = memos(context).conditionDepths; + let depths = memo.get(node.filePath); + const lines = fileLines(node.filePath, context); + if (!depths) { + depths = []; + let depth = 0; + for (const text of lines) { + depths.push(depth); + if (text.includes('{$')) depth = conditionDepthAfter(text, depth); + } + memo.set(node.filePath, depths); + } + const line = lines[node.startLine - 1] ?? ''; + return conditionDepthAfter(line.slice(0, node.startColumn), depths[node.startLine - 1] ?? 0) > 0; +} + +/** The depth of conditional blocks after a line's directives (`{$IFDEF X}` opens one, `{$ENDIF}` closes it). */ +function conditionDepthAfter(text: string, depth: number): number { + for (const m of text.matchAll(/\{\$(ifdef|ifndef|ifopt|ifend|endif|if)\b/gi)) { + const directive = m[1]!.toLowerCase(); + depth = directive === 'endif' || directive === 'ifend' ? Math.max(0, depth - 1) : depth + 1; + } + return depth; +} + +/** + * The class whose method makes a call: the one the nearest method header + * above the call names in the source text (`procedure TFoo.Bar;`), which holds + * where the tree had errors and gave the code to the file, or to a routine + * that swallowed the ones after it; else the reference's method's class. + */ +function classOfCall(ref: UnresolvedRef, context: ResolutionContext): Node | null { + const qn = headerClassAt(ref.filePath!, ref.line, context); + const cls = qn ? classByQualifiedName(qn, ref.filePath!, context) : null; + if (cls) return cls; + const routine = context.getNodeById?.(ref.fromNodeId); + return routine?.kind === 'method' ? classOfRoutine(routine, context) : null; +} + +/** + * The class the nearest routine header at or above a line names + * (`procedure TFoo.Bar;` → `TFoo`), or null when it is a free routine's, or + * the unit's code resumes there: after an `end;` that starts its line, or at + * `initialization`. + */ +function headerClassAt(filePath: string, line: number, context: ResolutionContext): string | null { + const memo = memos(context).headerClasses; + let headers = memo.get(filePath); + if (!headers) { + headers = []; + const lines = fileLines(filePath, context); + const header = /^(?:class\s+)?(?:procedure|function|constructor|destructor|operator)\s+([A-Za-z_][\w.<>, ]*?)\s*[(:;]/i; + for (let i = 0; i < lines.length; i++) { + const text = lines[i]!; + // Each starts its line with one of c, d, e, f, i, o, p (either case). + const first = text.charCodeAt(0) | 0x20; + if (first !== 0x63 && first !== 0x64 && first !== 0x65 && first !== 0x66 && first !== 0x69 && first !== 0x6f && first !== 0x70) continue; + if (/^(?:end;|(?:initialization|finalization)\b)/i.test(text)) { + headers.push({ line: i + 1, classQn: null, routine: false }); + continue; + } + const m = header.exec(text); + if (!m) continue; + const parts = m[1]!.replace(/<[^>]*>/g, '').replace(/\s+/g, '').split('.'); + headers.push({ line: i + 1, classQn: parts.length > 1 ? parts.slice(0, -1).join('::') : null, routine: true }); + } + memo.set(filePath, headers); + } + let lo = 0; + let hi = headers.length - 1; + let hit: string | null = null; + while (lo <= hi) { + const mid = (lo + hi) >> 1; + if (headers[mid]!.line <= line) { + hit = headers[mid]!.classQn; + lo = mid + 1; + } else { + hi = mid - 1; + } + } + return hit; +} + // --------------------------------------------------------------------------- // Scope lookup // --------------------------------------------------------------------------- @@ -105,27 +303,36 @@ function isRoutine(node: Node): boolean { return node.kind === 'method' || node.kind === 'function'; } -/** A bare name, looked up the way Delphi looks it up from a routine of class `cls` (null: a free routine). */ +/** A bare name, looked up the way Delphi looks it up from a routine of class `cls` (null: a free routine): a routine, or null. */ function nameInScope(name: string, cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): Found | null { - const lower = name.toLowerCase(); + const decl = declarationInScope(name.toLowerCase(), cls, ref, context); + return decl && isRoutine(decl.node) ? decl : null; +} + +/** + * The first declaration a bare name reaches from a routine of class `cls` + * (null: a free routine), whatever it declares: a member of the class or its + * ancestors, then a declaration of the unit, then of the units it uses, last + * first. Null when the project declares none of them, as for the System + * unit's names. + */ +function declarationInScope(lower: string, cls: Node | null, ref: UnresolvedRef, context: ResolutionContext): Found | null { const memo = memos(context).inScope; const key = `${cls?.id ?? ''}|${ref.filePath}|${lower}`; if (memo.has(key)) return memo.get(key)!; let found: Found | null = null; const member = cls ? memberInHierarchy(cls, lower, context) : null; if (member) { - if (isRoutine(member)) found = { node: member, resolvedBy: 'instance-method', confidence: 0.9 }; + found = { node: member, resolvedBy: 'instance-method', confidence: 0.9 }; } else { - const own = unitDeclaration(ref.filePath!, lower, context); + const own = ownUnitDeclaration(ref.filePath!, lower, context); if (own) { - if (isRoutine(own)) found = { node: own, resolvedBy: 'exact-match', confidence: 0.9 }; + found = { node: own, resolvedBy: 'exact-match', confidence: 0.9 }; } else { const used = usedUnitFiles(ref.filePath!, context); - for (let i = used.length - 1; i >= 0; i--) { - const decl = unitDeclaration(used[i]!, lower, context); - if (!decl) continue; - if (isRoutine(decl)) found = { node: decl, resolvedBy: 'import', confidence: 0.85 }; - break; + for (let i = used.length - 1; i >= 0 && !found; i--) { + const decl = unitDeclaration(used[i]!, lower, context, ref.filePath!); + if (decl) found = { node: decl, resolvedBy: 'import', confidence: 0.85 }; } } } @@ -141,7 +348,7 @@ function memberThroughPath(path: string[], cls: Node | null, ref: UnresolvedRef, let rest = path.slice(1); if (head.unitFile) { // `UnitName.Routine`, `UnitName.GlobalVar.Method`. - const decl = unitDeclaration(head.unitFile, rest[0]!.toLowerCase(), context); + 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); @@ -170,8 +377,9 @@ function headOf(name: string, cls: Node | null, ref: UnresolvedRef, context: Res const member = memberInHierarchy(cls, lower, context); if (member) return { type: typeOfMember(member, context) }; } - const decl = unitDeclaration(ref.filePath!, lower, context) ?? - usedUnitFiles(ref.filePath!, context).reduceRight((hit, file) => hit ?? unitDeclaration(file, lower, context), undefined); + 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) }; const unitFile = unitFileNamed(lower, ref.filePath!, context); return unitFile ? { type: null, unitFile } : null; @@ -191,10 +399,20 @@ interface Memos { usedFiles: Map; classByName: Map; unitsByName?: Map; + genericTypes?: Map; + projectFiles?: { byName: Map; pascal: string[] }; + includes: Map; + includers: Map; + ownFiles: Map; + unitFileSets: Map; unitFiles: Map; hierarchy: Map; memberTypes: Map; keywords: Map; + procedural: Map; + headerClasses: Map>; + outlines: Map; + conditionDepths: Map; } const MEMOS = new WeakMap(); @@ -204,7 +422,8 @@ function memos(context: ResolutionContext): Memos { m = { named: new Map(), inScope: new Map(), classOfRoutine: new Map(), classByQn: new Map(), ancestors: new Map(), usedFiles: new Map(), classByName: new Map(), unitFiles: new Map(), hierarchy: new Map(), - memberTypes: new Map(), keywords: new Map(), + memberTypes: new Map(), keywords: new Map(), procedural: new Map(), headerClasses: new Map(), outlines: new Map(), + conditionDepths: new Map(), unitFileSets: new Map(), includes: new Map(), includers: new Map(), ownFiles: new Map(), }; MEMOS.set(context, m); } @@ -248,11 +467,13 @@ function classByQualifiedName(qualifiedName: string, filePath: string, context: if (memo.has(key)) return memo.get(key)!; const exact = context.getNodesByQualifiedName(qualifiedName).filter((n) => n.language === 'pascal' && CLASS_KINDS.has(n.kind)); const lower = qualifiedName.toLowerCase(); - const cls = declarationOf(exact.filter((n) => n.filePath === filePath)) ?? - declarationOf(context.getNodesInFile(filePath).filter((n) => - CLASS_KINDS.has(n.kind) && n.qualifiedName.replace(/<[^>]*>/g, '').toLowerCase() === lower)) ?? - declarationOf(exact) ?? - classNamed(qualifiedName.split('::').pop()!, filePath, context); + let cls: Node | null = null; + for (const file of ownUnitFiles(filePath, context)) { + cls = declarationOf(exact.filter((n) => n.filePath === file)) ?? + declarationOf(outlineOf(file, context).classes.filter((n) => n.qualifiedName.replace(/<[^>]*>/g, '').toLowerCase() === lower)); + if (cls) break; + } + cls ??= declarationOf(exact) ?? classNamed(qualifiedName.split('::').pop()!, filePath, context); memo.set(key, cls); return cls; } @@ -334,46 +555,209 @@ function memberInHierarchy(cls: Node, lower: string, context: ResolutionContext) return found; } -/** A unit's top-level declaration of a name (its enum values included). */ -function unitDeclaration(filePath: string, lower: string, context: ResolutionContext): Node | undefined { +/** + * A unit's top-level declaration of a name (its enum values included), as + * code in `fromFile` sees it: another unit's member that its parse lost (see + * unitRoutineColumn) is not one, while in its own unit it is most likely the + * member the code calls. + */ +function unitDeclaration(filePath: string, lower: string, context: ResolutionContext, fromFile = filePath): Node | undefined { const decls = pascalNamed(lower, context).filter((n) => - n.filePath === filePath && UNIT_KINDS.has(n.kind) && (n.kind === 'enum_member' || !n.qualifiedName.includes('::'))); + n.filePath === filePath && UNIT_KINDS.has(n.kind) && (n.kind === 'enum_member' || !n.qualifiedName.includes('::')) && + !(fromFile !== filePath && n.kind === 'function' && n.startColumn > unitRoutineColumn(filePath, context))); // A routine declared in the interface and defined in the implementation is // one name; of overloads, one called without arguments first. return decls.find((n) => !isRoutine(n)) ?? decls.find((n) => !needsArguments(n)) ?? decls[0]; } -/** The files of the units a file uses, in the order its `uses` clauses name them. */ -function usedUnitFiles(filePath: string, context: ResolutionContext): string[] { - const memo = memos(context).usedFiles; - const hit = memo.get(filePath); - if (hit) return hit; - const files: string[] = []; - const imports = context.getNodesInFile(filePath) - .filter((n) => n.kind === 'import' && n.language === 'pascal') - .sort((a, b) => a.startLine - b.startLine || a.startColumn - b.startColumn); - for (const imp of imports) { - const file = unitFileNamed(imp.name.toLowerCase(), filePath, context); - if (file && file !== filePath && !files.includes(file)) files.push(file); +/** + * How far a unit's own routines are indented at most. In a unit whose + * `unit` header the parser lost, the members of a class it couldn't read + * come out as routines of the unit, indented deeper than the unit's own + * (`function Http: IHttpClient;` in a class body); elsewhere, any. + */ +function unitRoutineColumn(filePath: string, context: ResolutionContext): number { + return outlineOf(filePath, context).routineColumn; +} + +/** What scope lookups need of a file's nodes, read once: its classes, its `uses` in order, unitRoutineColumn. */ +function outlineOf(filePath: string, context: ResolutionContext): { classes: Node[]; imports: Node[]; routineColumn: number } { + const memo = memos(context).outlines; + let outline = memo.get(filePath); + if (!outline) { + const nodes = context.getNodesInFile(filePath); + let routineColumn = Infinity; + if (!nodes.some((n) => n.kind === 'module')) { + for (const n of nodes) { + if (n.kind === 'function' && !n.qualifiedName.includes('::')) routineColumn = Math.min(routineColumn, n.startColumn); + } + } + outline = { + classes: nodes.filter((n) => CLASS_KINDS.has(n.kind)), + imports: nodes.filter((n) => n.kind === 'import' && n.language === 'pascal') + .sort((a, b) => a.startLine - b.startLine || a.startColumn - b.startColumn), + routineColumn, + }; + memo.set(filePath, outline); } - memo.set(filePath, files); + return outline; +} + +/** The files of the units a file uses, in the order its `uses` clauses name them. */ +function usedUnitFiles(fromFile: string, context: ResolutionContext): string[] { + const memo = memos(context).usedFiles; + const hit = memo.get(fromFile); + if (hit) return hit; + // The unit's `uses` clauses, then those of the files it includes: mORMot's + // `.inc` files open the unit's implementation with one. + const unit = unitFilesOf(fromFile, context); + const files: string[] = []; + for (const own of unit) { + for (const imp of outlineOf(own, context).imports) { + const file = unitFileNamed(imp.name.toLowerCase(), own, context); + if (file && !unit.includes(file) && !files.includes(file)) files.push(file); + } + } + memo.set(fromFile, files); return files; } +/** The unit's own declaration of a name, seen from one of its files (see ownUnitFiles). */ +function ownUnitDeclaration(fromFile: string, lower: string, context: ResolutionContext): Node | undefined { + for (const file of ownUnitFiles(fromFile, context)) { + const decl = unitDeclaration(file, lower, context); + if (decl) return decl; + } + return undefined; +} + +/** + * The files whose declarations are a file's unit's own, the file first: the + * unit is its own file and the include files it pulls in, so code in + * `mormot.core.os.pas` sees a variable `mormot.core.os.posix.inc` declares, + * and that file's code sees the unit's (see unitFilesOf). + */ +function ownUnitFiles(filePath: string, context: ResolutionContext): string[] { + const memo = memos(context).ownFiles; + let own = memo.get(filePath); + if (!own) { + const unit = unitFilesOf(filePath, context); + own = unit[0] === filePath ? unit : [filePath, ...unit.filter((f) => f !== filePath)]; + memo.set(filePath, own); + } + return own; +} + +/** + * The files one unit is made of: its own file, then the include files it + * pulls in (`{$I name.inc}`, `{$INCLUDE name}`), nested ones too. For an + * include file, the unit that includes it, nearest it when several do. + */ +function unitFilesOf(filePath: string, context: ResolutionContext): string[] { + const m = memos(context); + const hit = m.unitFileSets.get(filePath); + if (hit) return hit; + let root = filePath; + for (let i = 0; i < 3 && /\.inc$/i.test(root); i++) { + const up = includerOf(root, context); + if (!up || up === filePath) break; + root = up; + } + const files = [root]; + for (let i = 0; i < files.length && files.length < 32; i++) { + for (const inc of includesOf(files[i]!, context)) if (!files.includes(inc)) files.push(inc); + } + if (!files.includes(filePath)) files.push(filePath); + m.unitFileSets.set(filePath, files); + return files; +} + +/** The include files a Pascal file pulls in (`{$I name.inc}`, `{$INCLUDE name}`), each the one of that name nearest it. */ +function includesOf(filePath: string, context: ResolutionContext): string[] { + const m = memos(context); + let includes = m.includes.get(filePath); + if (includes) return includes; + includes = []; + if (PASCAL_SOURCE.test(filePath)) { + for (const text of fileLines(filePath, context)) { + if (!text.includes('{$') || !/\{\$i(?:nclude)?\s/i.test(text)) continue; + for (const match of text.matchAll(/\{\$(?:I|INCLUDE)\s+['"]?([^'"}\s*]+)/gi)) { + let name = match[1]!.replace(/\\/g, '/'); + name = name.slice(name.lastIndexOf('/') + 1).toLowerCase(); + if (!name.includes('.')) name += '.inc'; + const inc = nearest(projectFiles(context).byName.get(name) ?? [], filePath); + if (inc && inc !== filePath && !includes.includes(inc)) includes.push(inc); + } + } + } + m.includes.set(filePath, includes); + return includes; +} + +/** The Pascal file that includes an include file: of the forty nearest it, the nearest whose text does. */ +function includerOf(incFile: string, context: ResolutionContext): string | null { + const m = memos(context); + if (m.includers.has(incFile)) return m.includers.get(incFile)!; + // The files of its directory first, those named most like it first of + // them (`mormot.core.os.pas` for `mormot.core.os.posix.inc`): how many + // characters of its path a file shares, the directory counting first. + const shared = (f: string): number => { + let n = 0; + while (n < f.length && n < incFile.length && f.charCodeAt(n) === incFile.charCodeAt(n)) n++; + return f.lastIndexOf('/', n - 1) * 1000 + n; + }; + const candidates = projectFiles(context).pascal.filter((f) => f !== incFile) + .map((f) => ({ f, n: shared(f) })).sort((a, b) => b.n - a.n).slice(0, 40); + const includer = candidates.find(({ f }) => includesOf(f, context).includes(incFile))?.f ?? null; + m.includers.set(incFile, includer); + return includer; +} + +const PASCAL_SOURCE = /\.(?:pas|dpr|dpk|lpr|inc)$/i; + +/** The project's files by lowercased name, and its Pascal sources. */ +function projectFiles(context: ResolutionContext): { byName: Map; pascal: string[] } { + const m = memos(context); + if (!m.projectFiles) { + const byName = new Map(); + const pascal: string[] = []; + for (const file of context.getAllFiles()) { + const base = file.slice(file.lastIndexOf('/') + 1).toLowerCase(); + const same = byName.get(base); + if (same) same.push(file); + else byName.set(base, [file]); + if (PASCAL_SOURCE.test(file)) pascal.push(file); + } + m.projectFiles = { byName, pascal }; + } + return m.projectFiles; +} + /** The file of the unit a name names, nearest to `fromFile` when several units share it. */ function unitFileNamed(lower: string, fromFile: string, context: ResolutionContext): string | null { const m = memos(context); const key = `${fromFile}|${lower}`; if (m.unitFiles.has(key)) return m.unitFiles.get(key)!; if (!m.unitsByName) { - m.unitsByName = new Map(); + const units = new Map(); + const add = (name: string, file: string): void => { + const files = units.get(name); + if (files) files.push(file); + else units.set(name, [file]); + }; + const headed = new Set(); for (const n of context.getNodesByKind('module')) { if (n.language !== 'pascal') continue; - const name = n.name.toLowerCase(); - const files = m.unitsByName.get(name); - if (files) files.push(n.filePath); - else m.unitsByName.set(name, [n.filePath]); + add(n.name.toLowerCase(), n.filePath); + headed.add(n.filePath); } + // A unit's file is named after it, which Delphi enforces: one whose + // `unit` header the parser lost to an error is the unit its file names. + for (const file of context.getAllFiles()) { + if (headed.has(file) || !/\.pas$/i.test(file)) continue; + add(file.slice(file.lastIndexOf('/') + 1, -'.pas'.length).toLowerCase(), file); + } + m.unitsByName = units; } const file = nearest(m.unitsByName.get(lower) ?? [], fromFile); m.unitFiles.set(key, file); @@ -381,23 +765,42 @@ function unitFileNamed(lower: string, fromFile: string, context: ResolutionConte } /** A class (or record or interface) a type name names, seen from `fromFile`. */ -function classNamed(typeName: string, fromFile: string, context: ResolutionContext): Node | null { +function classNamed(typeName: string, fromFile: string, context: ResolutionContext, depth = 0): Node | null { const simple = typeName.split('.').pop()!.toLowerCase(); const memo = memos(context).classByName; const key = `${fromFile}|${simple}`; if (memo.has(key)) return memo.get(key)!; - const candidates = pascalNamed(simple, context).filter((n) => CLASS_KINDS.has(n.kind)); - let cls = declarationOf(candidates.filter((n) => n.filePath === fromFile)); - if (!cls && candidates.length > 0) { - // The unit used last declares the name Delphi sees; else the one unit that does. + const named = pascalNamed(simple, context); + const visible = (kinds: ReadonlySet): Node[] => { + // In the unit's own files, then in the unit used last, which declares the + // name Delphi sees; else in the one unit that does. + const candidates = named.filter((n) => kinds.has(n.kind)); + for (const file of ownUnitFiles(fromFile, context)) { + const own = candidates.filter((n) => n.filePath === file); + if (own.length > 0) return own; + } const used = usedUnitFiles(fromFile, context); - for (let i = used.length - 1; i >= 0 && !cls; i--) cls = declarationOf(candidates.filter((n) => n.filePath === used[i])); - if (!cls && candidates.every((n) => n.filePath === candidates[0]!.filePath)) cls = declarationOf(candidates); + for (let i = used.length - 1; i >= 0; i--) { + const there = candidates.filter((n) => n.filePath === used[i]); + if (there.length > 0) return there; + } + return candidates.length > 0 && candidates.every((n) => n.filePath === candidates[0]!.filePath) ? candidates : []; + }; + let cls = declarationOf(visible(CLASS_KINDS)); + if (!cls && depth < 4) { + // A type alias names the class it stands for: `TVTAncestor = TVTAncestorVcl;`. + 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]; + if (target && (cls = classNamed(target, alias.filePath, context, depth + 1))) break; + } } memo.set(key, cls); return cls; } +const ALIAS_KINDS: ReadonlySet = new Set(['type_alias']); + /** The file whose path shares the longest directory prefix with `from`. */ function nearest(files: string[], from: string): string | null { if (files.length <= 1) return files[0] ?? null; @@ -436,18 +839,119 @@ function typeOfMember(member: Node, context: ResolutionContext): Node | null { if (member.kind === 'method' || member.kind === 'function') { typeName = member.returnType ?? /:\s*([A-Za-z_][\w.]*)\s*;?\s*$/.exec(member.signature ?? '')?.[1]; } else { - const line = fileLines(member.filePath, context)[member.startLine - 1] ?? ''; - const name = escapeRegExp(member.name); - const re = member.kind === 'property' - ? new RegExp(`\\bproperty\\s+${name}\\s*(?:\\[[^\\]]*\\])?\\s*:\\s*([A-Za-z_][\\w.]*)`, 'i') - : new RegExp(`\\b${name}\\b(?:\\s*,\\s*[A-Za-z_]\\w*)*\\s*:\\s*([A-Za-z_][\\w.]*)`, 'i'); - typeName = re.exec(line)?.[1]; + typeName = /^([A-Za-z_][\w.]*)/.exec(declaredTypeText(member, context))?.[1]; } const type = typeName ? classNamed(typeName, member.filePath, context) : null; memo.set(member.id, type); return type; } +/** + * The text of the type a field, variable, constant or property declares, + * from its declaration on: `TFoo; // the foo` for `FFoo: TFoo; // the foo`. + * A name in a comma list (`FOnLoad,` above `FOnSave: TSaveEvent;`) takes the + * type the list ends with, a few lines down. Empty when none is written, as + * for a published `property OnClick;`. + */ +function declaredTypeText(node: Node, context: ResolutionContext): string { + const lines = fileLines(node.filePath, context); + const name = escapeRegExp(node.name); + const re = node.kind === 'property' + ? new RegExp(`\\bproperty\\s+${name}\\s*(?:\\[[^\\]]*\\])?\\s*:\\s*(.*)$`, 'i') + : new RegExp(`\\b${name}\\b(?:\\s*,\\s*[A-Za-z_]\\w*)*\\s*,?\\s*:(?!=)\\s*(.*)$`, 'i'); + let text = ''; + for (let i = node.startLine - 1; i < node.startLine + 5 && i < lines.length; i++) { + text += ' ' + lines[i]!.replace(/\/\/.*$|\{[^}]*\}|\(\*.*?\*\)/g, ' '); + const m = re.exec(text); + if (m) return m[1]!.trim(); + // A list goes on only after a comma. + if (node.kind === 'property' || !/,\s*$/.test(text)) break; + } + return ''; +} + +/** + * Whether data holds a routine, by its declared type: one written in place + * (`FProc: procedure of object`, `F: reference to function: Integer`), a + * project type declared as one (`TOnLog = procedure(...) of object;`), or a + * type the project doesn't declare that the RTL's names say is one + * (`TNotifyEvent`, `TWndMethod`, `TProc`). + */ +function isProceduralData(node: Node, context: ResolutionContext): boolean { + const memo = memos(context).procedural; + const hit = memo.get(node.id); + if (hit !== undefined) return hit; + const procedural = isProceduralTypeText(declaredTypeText(node, context), context, 0); + memo.set(node.id, procedural); + return procedural; +} + +/** + * Whether a written type is a routine's: written out + * (`reference to function: Integer`), or named, with the name's declaration + * saying so, through an alias to another such name + * (`TFormatter = TFunc;`). A name the project doesn't + * declare is a routine type when the RTL's names say so: `TProc`, `TFunc`, + * and the names Delphi gives them (`TNotifyEvent`, `TWndMethod`). + */ +function isProceduralTypeText(text: string, context: ResolutionContext, depth: number): boolean { + 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; + const types = typesNamed(typeName, context); + if (types.length === 0) return RTL_PROCEDURAL_TYPES.has(typeName) || /^t\w*(?:event|proc|method|callback)$/.test(typeName); + return types.some((t) => t.kind === 'type_alias' && isProceduralTypeText(aliasedTypeText(t, context), context, depth + 1)); +} + +/** + * The project's Pascal types a name names, generic ones by the name before + * their parameters: `TSetParams` for `TSetParams`. + */ +function typesNamed(lower: string, context: ResolutionContext): Node[] { + const m = memos(context); + if (!m.genericTypes) { + const generic = new Map(); + const add = (n: Node): void => { + const open = n.name.indexOf('<'); + if (n.language !== 'pascal' || open <= 0 || !(n.kind === 'type_alias' || CLASS_KINDS.has(n.kind))) return; + const base = n.name.slice(0, open).trim().toLowerCase(); + const list = generic.get(base); + if (list) list.push(n); + else generic.set(base, [n]); + }; + const kinds = ['type_alias', 'class', 'struct', 'interface'] as const; + // The names alone first, where the index can tell them, to fetch only + // the generic types. + const names = context.getNodeNamesOfKinds?.('pascal', kinds); + if (names) { + for (const name of new Set(names)) if (name.includes('<')) context.getNodesByName(name).forEach(add); + } else { + for (const kind of kinds) for (const n of context.iterateNodesByKind?.(kind) ?? context.getNodesByKind(kind)) add(n); + } + m.genericTypes = generic; + } + return pascalNamed(lower, context).filter((t) => t.kind === 'type_alias' || CLASS_KINDS.has(t.kind)) + .concat(m.genericTypes.get(lower) ?? []); +} + +/** + * What a type declaration says after its `=`, which may start on the next + * line: `procedure(...) of object` for `TOnHelper =` above it. + */ +function aliasedTypeText(alias: Node, context: ResolutionContext): string { + const lines = fileLines(alias.filePath, context); + let text = ''; + for (let i = alias.startLine - 1; i < alias.startLine + 2 && i < lines.length; i++) { + text += ' ' + lines[i]!.replace(/\/\/.*$|\{[^}]*\}|\(\*.*?\*\)/g, ' '); + const eq = text.indexOf('='); + if (eq >= 0 && text.slice(eq + 1).trim()) return text.slice(eq + 1).trim(); + } + return ''; +} + +/** A routine type written out: `procedure(...) of object`, `function: T`, `reference to procedure`. */ +const PROCEDURAL_TYPE = /^(?:reference\s+to\s+)?(?:procedure|function)\b/i; + /** Whether a routine has a parameter without a default value, which a call must pass. */ function needsArguments(routine: Node): boolean { const signature = routine.signature?.trim();