codegraph/__tests__/pascal-reference-boundaries.test.ts

/**
 * 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<string, string>): Promise<CodeGraph> {
  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']);
  });
});