<commit_before>unit uUnitParser;

interface

{$I ..\Testgrip.inc}

uses
  Classes, Contnrs, uPascalDefs;

type
  TFileBoundary = record
    Start: Integer;
    Stop: Integer;
  end;

  TUnitParser = class
  protected
    FRawOuterUsesList: TStrings;
    FRawInnerUsesList: TStrings;
    FOuterUsesList: TStrings;
    FInnerUsesList: TStrings;

    FInterfaceClassList: TStrings;

    FRequires: TStrings;

    FBufferSize: integer;

    FMethodList: TObjectList;
    FInterfaceMethodList: TObjectList;
    FNonPrivateMethods: TStrings;

    FPropertyList: TObjectList;
    FVariableList: TObjectList;

    FInitCode: TStrings;

    FHasUTF8BOM: boolean;

    FStartOfImplementation: integer;

    FOuterUsesBoundaries: TFileBoundary;
    FInnerUsesBoundaries: TFileBoundary;

    function GetHasOuterUses: Boolean;
    function GetHasInnerUses: Boolean;

    {$IFDEF DELPHI2009_UP}
    function ReadLoopUntilSemiColon(const sIn: string; iStart: integer; var sOut: string): boolean;
    {$ELSE}
    function ReadLoopUntilSemiColon(const sIn: ansistring; iStart: integer; var sOut: ansistring): boolean;
    {$ENDIF}

    procedure ParseUsesList( const lstIn: TStrings; const lstOut: TStrings; bIsDkp: boolean = False );

    procedure ExtractAllMethods( const s: TStream; bGetLineNumbers: boolean = False; iLineNumberOffset: integer = 0 );

    function ExtractParentClassFromDefinition( const s: string ): string;

    function FilterVariable( const s: string ): string;

    procedure UpdateMethodBasedOnDefinition(const aMethod: TMethodDefinition);
  public
    property HasUTF8BOM: boolean
      read FHasUTF8BOM;

    property BufferSize: integer
      read FBufferSize write FBufferSize;

    property Requires: TStrings
      read FRequires;

    property RawOuterUsesList: TStrings
      read FRawOuterUsesList;
    property RawInnerUsesList: TStrings
      read FRawInnerUsesList;

    property OuterUsesList: TStrings
      read FOuterUsesList;
    property InnerUsesList: TStrings
      read FInnerUsesList;

    property MethodList: TObjectList
      read FMethodList;
    property InterfaceMethodList: TObjectList
      read FInterfaceMethodList;

    property PropertyList: TObjectList
      read FPropertyList;
    property VariableList: TObjectList
      read FVariableList;

    property NonPrivateMethods: TStrings
      read FNonPrivateMethods;

    property InitCode: TStrings
      read FInitCode;

    property StartOfImplementation: integer
      read FStartOfImplementation;

    property InterfaceClassList: TStrings
      read FInterfaceClassList;

    property OuterUsesBoundaries: TFileBoundary
      read FOuterUsesBoundaries;
    property InnerUsesBoundaries: TFileBoundary
      read FInnerUsesBoundaries;

    property HasOuterUses: Boolean
      read GetHasOuterUses;
    property HasInnerUses: Boolean
      read GetHasInnerUses;

    constructor Create;
    destructor Destroy; override;

    procedure ParseUnit( const s: TStream; bExtractMethods: boolean = False; bExtractDprInit: boolean = False; bIsDpk: boolean = false; bExtractProperties: boolean = False; bGetLineNumbers: boolean = False );
    procedure ParseFromFile(const AFilename: string; bExtractMethods: Boolean; bExtractDprInit: Boolean = False; bIsDpk: Boolean = False; bExtractProperties: boolean = False; bGetLineNumbers: boolean = False);

    function GetCreateCodeFromClass( const sClassName: string): string;

    function FindClosestMethodDefinition(const aMDef: TMethodDefinition): TMethodDefinition;

    function FindNextMethodAfter(const aMethod: TMethodDefinition): TMethodDefinition;

    function IsNonPrivate(const sSigniture: string): boolean;

    function GetDefinition(const sSigniture: string): TMethodDefinition;

    /// <summary>Fill lst with methoddefinitions within given class, DO NOT FREE definitions</summary>
    procedure ListInterfaceMethods(const sClassname: string; const lst: TList);
  end;

  function GetFirstMethodDefinitionFromSourceByName( const sPascalFile: string; const sMethodName: string; const sClassName: string; bIncludeLineNumer: boolean = False ): TMethodDefinition;
  function GetFirstMethodDefinitionFromSourceBySignature( const sPascalFile: string; const sSignature: string; bIncludeLineNumer: boolean = False ): TMethodDefinition;

  function IsValidPascalIdentifier(const sIdent: string): boolean;

implementation

uses
  StrUtils, SysUtils, Math, uCommonFunctions{$ifdef VER150}, uD7Functions{$endif};


function IsValidPascalIdentifier(const sIdent: string): boolean;
begin
  {$ifdef VER150}
  Result := IsValidIdent(sIdent);
  {$else}
  Result := IsValidIdent(sIdent, false);
  {$endif}
end;


{ TUnitParser }

function TUnitParser.ExtractParentClassFromDefinition(const s: string): string;
var
  i, j: integer;
begin
  Result := '';

  i := Pos( '(', s );
  if i <> 0 then
  begin
    Inc(i);
    j := PosEx( ')', s, i );
    if j <> 0 then
    begin    
      Result := Trim( Copy(s, i, j - i ) );
    end;
  end;
end;

function TUnitParser.FilterVariable(const s: string): string;
var
  i, c: integer;
  state: integer;
begin
  Result := '';
  state := 0;

  c := Length(s);
  for i := c downto 1 do
  begin
    if (s[i] = ':') and (state = 0) then
    begin
      state := 1;
    end
    {$IFDEF DELPHI2009_UP}
    else if CharInSet(s[i], [#13,#10,#7,' ']) then
    {$ELSE}
    else if (s[i] in [#13,#10,#7,' ']) then
    {$ENDIF}
    begin
      // continue unless state=2
      if state = 2 then
      begin
        break;
      end;
    end
    else if (state = 1) then
    begin
      state := 2;
    end;

    Result := s[i] + Result;
  end;
end;

procedure TUnitParser.UpdateMethodBasedOnDefinition(const aMethod: TMethodDefinition);
var
  sSigniture: string;
  Definition: TMethodDefinition;
begin
  sSigniture := aMethod.Signature;
  Definition := GetDefinition(sSigniture);
  if Assigned(Definition) then
  begin
    aMethod.Scope := Definition.Scope;
    aMethod.IsOverride := Definition.IsOverride;
    aMethod.IsVirtual := Definition.IsVirtual;
    aMethod.IsOverloaded := Definition.IsOverloaded;
  end;
end;

function TUnitParser.FindClosestMethodDefinition(const aMDef: TMethodDefinition): TMethodDefinition;
var
  i, c: integer;
  j, d: integer;
  mdef: TMethodDefinition;
  aHighestMatched: TMethodDefinition;
  iHighestMatchScore: integer;
  iCurrentScore: integer;
  bMatchAll: boolean;
begin
  aHighestMatched := nil;
  iHighestMatchScore := 0;
  bMatchAll := False;

  c := FMethodList.Count - 1;
  for i := 0 to c do
  begin
    mdef := TMethodDefinition(FMethodList[i]);

    if SameText(aMDef.InClass, mdef.InClass) then
    begin
      if SameText(aMDef.DefMethodName, mdef.DefMethodName) then
      begin
        iCurrentScore := 1;

        d := aMDef.ParamTypes.Count - 1;
        for j := 0 to d do
        begin
          if (j < mdef.ParamTypes.Count) then
          begin
            if SameText(mdef.ParamTypes[j], aMDef.ParamTypes[j]) then
            begin
              Inc(iCurrentScore);

              if j = (mdef.ParamTypes.Count - 1) then
              begin
                bMatchAll := (mdef.ParamTypes.Count = aMDef.ParamTypes.Count);
                break;
              end;
            end
            else
            begin
              // zodra het niet meer overeenkomt, geen matchpunten meer
              break;
            end;
          end
          else
          begin
            break;
          end;
        end;

        if (iCurrentScore > iHighestMatchScore) then
        begin
          aHighestMatched     := mdef;
          iHighestMatchScore  := iCurrentScore;

          if bMatchAll then
          begin
            break;
          end;
        end;
      end;
    end;

  end;

  Result := aHighestMatched;
end;

function TUnitParser.FindNextMethodAfter(const aMethod: TMethodDefinition): TMethodDefinition;
var
  AnotherMethod: TMethodDefinition;
  MethodIdx, MethodCount: Integer;
begin
  Result := nil;

  MethodCount := FMethodList.Count - 1;
  for MethodIdx := 0 to MethodCount do
  begin
    AnotherMethod := TMethodDefinition(FMethodList[MethodIdx]);

    if Assigned(Result) then
    begin
      if (AnotherMethod.LineNumber > aMethod.LineNumber) and (AnotherMethod.LineNumber < Result.LineNumber) then
      begin
        Result := AnotherMethod;
      end;
    end
    else if AnotherMethod.LineNumber > aMethod.LineNumber then
    begin
      Result := AnotherMethod;
    end;
  end;
end;

constructor TUnitParser.Create;
begin
  FRawOuterUsesList := TStringList.Create;
  FRawInnerUsesList := TStringList.Create;
  FOuterUsesList := TStringList.Create;
  FInnerUsesList := TStringList.Create;
  FRequires := TStringList.Create;

  FMethodList := TObjectList.Create(True);
  FInterfaceMethodList := TObjectList.Create(True);
  FPropertyList := TObjectList.Create(True);
  FVariableList := TObjectList.Create(True);

  FInitCode := TStringList.Create;

  FInterfaceClassList := TStringList.Create;

  FNonPrivateMethods := TStringList.Create;

  FBufferSize := 2048;

  FStartOfImplementation := -1;
end;

destructor TUnitParser.Destroy;
var
  Idx: Integer;
begin
  for Idx := 0 to FNonPrivateMethods.Count - 1 do
    FNonPrivateMethods.Objects[Idx].Free;

  FreeAndNil(FNonPrivateMethods);

  for Idx := 0 to FInterfaceClassList.Count - 1 do
    FInterfaceClassList.Objects[Idx].Free;

  FreeAndNil(FInterfaceClassList);

  FreeAndNil(FInitCode);

  FreeAndNil(FVariableList);
  FreeAndNil(FPropertyList);
  FreeAndNil(FInterfaceMethodList);
  FreeAndNil(FMethodList);

  FreeAndNil(FRequires);

  FreeAndNil(FInnerUsesList);
  FreeAndNil(FOuterUsesList);
  FreeAndNil(FRawInnerUsesList);
  FreeAndNil(FRawOuterUsesList);

  inherited;
end;

procedure TUnitParser.ExtractAllMethods(const s: TStream; bGetLineNumbers: boolean; iLineNumberOffset: integer);
var
  bEof: boolean;
  iRead: integer;
  {$IFDEF DELPHI2009_UP}
  largeblock: string;
  largeblocklowercase: string;
  {$ENDIF}
  ansiblock: ansistring;
  ansilargeblock: ansistring;
  ansilargeblocklowercase: ansistring;
  sMethodDef: ansistring;
  i: integer;
  pc, pd, pp, pf: integer;
  bInParams: boolean;
  bInMethodDef: boolean;
  fdef: TMethodDefinition;
  iAnotherLineOffset: integer;
  iMethodLineNumber: integer;
  iMethodDefinitionLineCount: Integer;
  iSkip: integer;
begin
  bInParams := False;
  sMethodDef := '';
  {$IFDEF DELPHI2009_UP}
  largeblock := '';
  {$ENDIF}
  ansilargeblock := '';
  bInMethodDef := false;
  iAnotherLineOffset := iLineNumberOffset;

  i := 1;

  bEof := False;
  while not (bEof and (i >= Length(ansilargeblock))) do
  begin
    SetLength(ansiblock,FBufferSize);

    if i >= Length(ansilargeblock) then
    begin
      iRead := s.Read( ansiblock[1], FBufferSize );
      if iRead < FBufferSize then
      begin
        SetLength(ansiblock,iRead);
      end;

      if iRead = 0 then
      begin
        bEof := True;
      end;

      ansilargeblock := ansilargeblock + ansiblock;
    end;

    if not bInMethodDef then
    begin
      iSkip := Length(ansilargeblock);
      {$IFDEF DELPHI2009_UP}
      largeblock := string(ansilargeblock);
      largeblocklowercase := LowerCase(largeblock);
      pc := PosEx('constructor ', largeblocklowercase, Max(1, i - 11));
      pd := PosEx('destructor ', largeblocklowercase, Max(1, i - 10));
      pp := PosEx('procedure ', largeblocklowercase, Max(1, i - 9));
      pf := PosEx('function ', largeblocklowercase, Max(1, i - 8));
      largeblocklowercase := '';
      {$ELSE}
      ansilargeblocklowercase := LowerCase(ansilargeblock);
      pc := PosEx('constructor ', ansilargeblocklowercase, Max(1, i - 11));
      pd := PosEx('destructor ', ansilargeblocklowercase, Max(1, i - 10));
      pp := PosEx('procedure ', ansilargeblocklowercase, Max(1, i - 9));
      pf := PosEx('function ', ansilargeblocklowercase, Max(1, i - 8));
      ansilargeblocklowercase := '';
      {$ENDIF}

      {$IFDEF DELPHI2009_UP}
      if (pc > 2) and not CharInSet(ansilargeblock[pc - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pc > 2) and not (ansilargeblock[pc - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pc + 12, iSkip);
        pc := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pd > 2) and not CharInSet(ansilargeblock[pd - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pd > 2) and not (ansilargeblock[pd - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pd + 11, iSkip);
        pd := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pp > 2) and not CharInSet(ansilargeblock[pp - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pp > 2) and not (ansilargeblock[pp - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pp + 10, iSkip);
        pp := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pf > 2) and not CharInSet(ansilargeblock[pf - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pf > 2) and not (ansilargeblock[pf - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pf + 9, iSkip);
        pf := 0;
      end;

      i := 0;
      if (pc <> 0) then
      begin
        if i = 0 then
        begin
          i := pc;
        end
        else
        begin
          i := Min( i, pc );
        end;
      end;

      if pd <> 0 then
      begin
        if i = 0 then
        begin
          i := pd;
        end
        else
        begin
          i := Min( i, pd );
        end;
      end;

      if pp <> 0 then
      begin
        if i = 0 then
        begin
          i := pp;
        end
        else
        begin
          i := Min( i, pp );
        end;
      end;

      if pf <> 0 then
      begin
        if i = 0 then
        begin
          i := pf;
        end
        else
        begin
          i := Min( i, pf );
        end;
      end;

      if i <> 0 then
      begin
        bInMethodDef := True;
        sMethodDef := '';
      end
      else
      begin
        i := iSkip;
      end;
    end;

    if bInMethodDef then
    begin
      sMethodDef := sMethodDef + ansilargeblock[i];

      if bInParams then
      begin
        if ansilargeblock[i] = ')' then
        begin
          bInParams := False;
        end;
      end
      else
      begin
        if ansilargeblock[i] = '(' then
        begin
          bInParams := True;
        end
        else if ansilargeblock[i] = ';' then
        begin
          bInMethodDef := False;

          fdef := TMethodDefinition.Create(string(sMethodDef), false, csUnknown);
          if IsValidPascalIdentifier(fdef.DefMethodName) then
          begin
            if bGetLineNumbers then
            begin
              iMethodLineNumber := TCommonStringFunctions.CountLines(string(ansilargeblock), lfDos, i);
              iMethodDefinitionLineCount := TCommonStringFunctions.CountLines(string(sMethodDef), lfDos);

              fdef.LineNumber := iAnotherLineOffset + iMethodLineNumber - iMethodDefinitionLineCount;

              iAnotherLineOffset := iAnotherLineOffset + iMethodLineNumber;
            end;

            UpdateMethodBasedOnDefinition(fdef);

            FMethodList.Add( fdef );
          end
          else
          begin
            fdef.Free;

            sMethodDef := '';
          end;

          ansilargeblock := Copy(ansilargeblock, i + 1);
          i := 1;
        end;
      end;

      Inc(i);
    end;
  end;
end;

function TUnitParser.GetCreateCodeFromClass(const sClassName: string): string;
var
  i, c: integer;
  j, d: integer;
  m: TMethodDefinition;
  sParamType: string;
  sParamVal: string;
  sAllParams: string;
  sParentClass: string;<commit_msg>GDK-112: Bugfix casting AnsiString to string while reading a unit.<commit_after>unit uUnitParser;

interface

{$I ..\Testgrip.inc}

uses
  Classes, Contnrs, uPascalDefs;

type
  TFileBoundary = record
    Start: Integer;
    Stop: Integer;
  end;

  TUnitParser = class
  protected
    FRawOuterUsesList: TStrings;
    FRawInnerUsesList: TStrings;
    FOuterUsesList: TStrings;
    FInnerUsesList: TStrings;

    FInterfaceClassList: TStrings;

    FRequires: TStrings;

    FBufferSize: integer;

    FMethodList: TObjectList;
    FInterfaceMethodList: TObjectList;
    FNonPrivateMethods: TStrings;

    FPropertyList: TObjectList;
    FVariableList: TObjectList;

    FInitCode: TStrings;

    FHasUTF8BOM: boolean;

    FStartOfImplementation: integer;

    FOuterUsesBoundaries: TFileBoundary;
    FInnerUsesBoundaries: TFileBoundary;

    function GetHasOuterUses: Boolean;
    function GetHasInnerUses: Boolean;

    {$IFDEF DELPHI2009_UP}
    function ReadLoopUntilSemiColon(const sIn: string; iStart: integer; var sOut: string): boolean;
    {$ELSE}
    function ReadLoopUntilSemiColon(const sIn: ansistring; iStart: integer; var sOut: ansistring): boolean;
    {$ENDIF}

    procedure ParseUsesList( const lstIn: TStrings; const lstOut: TStrings; bIsDkp: boolean = False );

    procedure ExtractAllMethods( const s: TStream; bGetLineNumbers: boolean = False; iLineNumberOffset: integer = 0 );

    function ExtractParentClassFromDefinition( const s: string ): string;

    function FilterVariable( const s: string ): string;

    procedure UpdateMethodBasedOnDefinition(const aMethod: TMethodDefinition);
  public
    property HasUTF8BOM: boolean
      read FHasUTF8BOM;

    property BufferSize: integer
      read FBufferSize write FBufferSize;

    property Requires: TStrings
      read FRequires;

    property RawOuterUsesList: TStrings
      read FRawOuterUsesList;
    property RawInnerUsesList: TStrings
      read FRawInnerUsesList;

    property OuterUsesList: TStrings
      read FOuterUsesList;
    property InnerUsesList: TStrings
      read FInnerUsesList;

    property MethodList: TObjectList
      read FMethodList;
    property InterfaceMethodList: TObjectList
      read FInterfaceMethodList;

    property PropertyList: TObjectList
      read FPropertyList;
    property VariableList: TObjectList
      read FVariableList;

    property NonPrivateMethods: TStrings
      read FNonPrivateMethods;

    property InitCode: TStrings
      read FInitCode;

    property StartOfImplementation: integer
      read FStartOfImplementation;

    property InterfaceClassList: TStrings
      read FInterfaceClassList;

    property OuterUsesBoundaries: TFileBoundary
      read FOuterUsesBoundaries;
    property InnerUsesBoundaries: TFileBoundary
      read FInnerUsesBoundaries;

    property HasOuterUses: Boolean
      read GetHasOuterUses;
    property HasInnerUses: Boolean
      read GetHasInnerUses;

    constructor Create;
    destructor Destroy; override;

    procedure ParseUnit( const s: TStream; bExtractMethods: boolean = False; bExtractDprInit: boolean = False; bIsDpk: boolean = false; bExtractProperties: boolean = False; bGetLineNumbers: boolean = False );
    procedure ParseFromFile(const AFilename: string; bExtractMethods: Boolean; bExtractDprInit: Boolean = False; bIsDpk: Boolean = False; bExtractProperties: boolean = False; bGetLineNumbers: boolean = False);

    function GetCreateCodeFromClass( const sClassName: string): string;

    function FindClosestMethodDefinition(const aMDef: TMethodDefinition): TMethodDefinition;

    function FindNextMethodAfter(const aMethod: TMethodDefinition): TMethodDefinition;

    function IsNonPrivate(const sSigniture: string): boolean;

    function GetDefinition(const sSigniture: string): TMethodDefinition;

    /// <summary>Fill lst with methoddefinitions within given class, DO NOT FREE definitions</summary>
    procedure ListInterfaceMethods(const sClassname: string; const lst: TList);
  end;

  function GetFirstMethodDefinitionFromSourceByName( const sPascalFile: string; const sMethodName: string; const sClassName: string; bIncludeLineNumer: boolean = False ): TMethodDefinition;
  function GetFirstMethodDefinitionFromSourceBySignature( const sPascalFile: string; const sSignature: string; bIncludeLineNumer: boolean = False ): TMethodDefinition;

  function IsValidPascalIdentifier(const sIdent: string): boolean;

implementation

uses
  StrUtils, SysUtils, Math, uCommonFunctions{$ifdef VER150}, uD7Functions{$endif};


function IsValidPascalIdentifier(const sIdent: string): boolean;
begin
  {$ifdef VER150}
  Result := IsValidIdent(sIdent);
  {$else}
  Result := IsValidIdent(sIdent, false);
  {$endif}
end;


{ TUnitParser }

function TUnitParser.ExtractParentClassFromDefinition(const s: string): string;
var
  i, j: integer;
begin
  Result := '';

  i := Pos( '(', s );
  if i <> 0 then
  begin
    Inc(i);
    j := PosEx( ')', s, i );
    if j <> 0 then
    begin    
      Result := Trim( Copy(s, i, j - i ) );
    end;
  end;
end;

function TUnitParser.FilterVariable(const s: string): string;
var
  i, c: integer;
  state: integer;
begin
  Result := '';
  state := 0;

  c := Length(s);
  for i := c downto 1 do
  begin
    if (s[i] = ':') and (state = 0) then
    begin
      state := 1;
    end
    {$IFDEF DELPHI2009_UP}
    else if CharInSet(s[i], [#13,#10,#7,' ']) then
    {$ELSE}
    else if (s[i] in [#13,#10,#7,' ']) then
    {$ENDIF}
    begin
      // continue unless state=2
      if state = 2 then
      begin
        break;
      end;
    end
    else if (state = 1) then
    begin
      state := 2;
    end;

    Result := s[i] + Result;
  end;
end;

procedure TUnitParser.UpdateMethodBasedOnDefinition(const aMethod: TMethodDefinition);
var
  sSigniture: string;
  Definition: TMethodDefinition;
begin
  sSigniture := aMethod.Signature;
  Definition := GetDefinition(sSigniture);
  if Assigned(Definition) then
  begin
    aMethod.Scope := Definition.Scope;
    aMethod.IsOverride := Definition.IsOverride;
    aMethod.IsVirtual := Definition.IsVirtual;
    aMethod.IsOverloaded := Definition.IsOverloaded;
  end;
end;

function TUnitParser.FindClosestMethodDefinition(const aMDef: TMethodDefinition): TMethodDefinition;
var
  i, c: integer;
  j, d: integer;
  mdef: TMethodDefinition;
  aHighestMatched: TMethodDefinition;
  iHighestMatchScore: integer;
  iCurrentScore: integer;
  bMatchAll: boolean;
begin
  aHighestMatched := nil;
  iHighestMatchScore := 0;
  bMatchAll := False;

  c := FMethodList.Count - 1;
  for i := 0 to c do
  begin
    mdef := TMethodDefinition(FMethodList[i]);

    if SameText(aMDef.InClass, mdef.InClass) then
    begin
      if SameText(aMDef.DefMethodName, mdef.DefMethodName) then
      begin
        iCurrentScore := 1;

        d := aMDef.ParamTypes.Count - 1;
        for j := 0 to d do
        begin
          if (j < mdef.ParamTypes.Count) then
          begin
            if SameText(mdef.ParamTypes[j], aMDef.ParamTypes[j]) then
            begin
              Inc(iCurrentScore);

              if j = (mdef.ParamTypes.Count - 1) then
              begin
                bMatchAll := (mdef.ParamTypes.Count = aMDef.ParamTypes.Count);
                break;
              end;
            end
            else
            begin
              // zodra het niet meer overeenkomt, geen matchpunten meer
              break;
            end;
          end
          else
          begin
            break;
          end;
        end;

        if (iCurrentScore > iHighestMatchScore) then
        begin
          aHighestMatched     := mdef;
          iHighestMatchScore  := iCurrentScore;

          if bMatchAll then
          begin
            break;
          end;
        end;
      end;
    end;

  end;

  Result := aHighestMatched;
end;

function TUnitParser.FindNextMethodAfter(const aMethod: TMethodDefinition): TMethodDefinition;
var
  AnotherMethod: TMethodDefinition;
  MethodIdx, MethodCount: Integer;
begin
  Result := nil;

  MethodCount := FMethodList.Count - 1;
  for MethodIdx := 0 to MethodCount do
  begin
    AnotherMethod := TMethodDefinition(FMethodList[MethodIdx]);

    if Assigned(Result) then
    begin
      if (AnotherMethod.LineNumber > aMethod.LineNumber) and (AnotherMethod.LineNumber < Result.LineNumber) then
      begin
        Result := AnotherMethod;
      end;
    end
    else if AnotherMethod.LineNumber > aMethod.LineNumber then
    begin
      Result := AnotherMethod;
    end;
  end;
end;

constructor TUnitParser.Create;
begin
  FRawOuterUsesList := TStringList.Create;
  FRawInnerUsesList := TStringList.Create;
  FOuterUsesList := TStringList.Create;
  FInnerUsesList := TStringList.Create;
  FRequires := TStringList.Create;

  FMethodList := TObjectList.Create(True);
  FInterfaceMethodList := TObjectList.Create(True);
  FPropertyList := TObjectList.Create(True);
  FVariableList := TObjectList.Create(True);

  FInitCode := TStringList.Create;

  FInterfaceClassList := TStringList.Create;

  FNonPrivateMethods := TStringList.Create;

  FBufferSize := 2048;

  FStartOfImplementation := -1;
end;

destructor TUnitParser.Destroy;
var
  Idx: Integer;
begin
  for Idx := 0 to FNonPrivateMethods.Count - 1 do
    FNonPrivateMethods.Objects[Idx].Free;

  FreeAndNil(FNonPrivateMethods);

  for Idx := 0 to FInterfaceClassList.Count - 1 do
    FInterfaceClassList.Objects[Idx].Free;

  FreeAndNil(FInterfaceClassList);

  FreeAndNil(FInitCode);

  FreeAndNil(FVariableList);
  FreeAndNil(FPropertyList);
  FreeAndNil(FInterfaceMethodList);
  FreeAndNil(FMethodList);

  FreeAndNil(FRequires);

  FreeAndNil(FInnerUsesList);
  FreeAndNil(FOuterUsesList);
  FreeAndNil(FRawInnerUsesList);
  FreeAndNil(FRawOuterUsesList);

  inherited;
end;

procedure TUnitParser.ExtractAllMethods(const s: TStream; bGetLineNumbers: boolean; iLineNumberOffset: integer);
var
  bEof: boolean;
  iRead: integer;
  {$IFDEF DELPHI2009_UP}
  largeblock: string;
  largeblocklowercase: string;
  sMethodDef: string;
  {$ELSE}
  largeblock: ansistring;
  largeblocklowercase: ansistring;
  sMethodDef: ansistring;
  {$ENDIF}
  ansiblock: ansistring;
  ansilargeblock: ansistring;
  i: integer;
  pc, pd, pp, pf: integer;
  bInParams: boolean;
  bInMethodDef: boolean;
  fdef: TMethodDefinition;
  iAnotherLineOffset: integer;
  iMethodLineNumber: integer;
  iMethodDefinitionLineCount: Integer;
  iSkip: integer;
begin
  bInParams := False;
  sMethodDef := '';
  largeblock := '';
  ansilargeblock := '';
  bInMethodDef := false;
  iAnotherLineOffset := iLineNumberOffset;

  i := 1;

  bEof := False;
  while not (bEof and (i >= Length(ansilargeblock))) do
  begin
    SetLength(ansiblock, FBufferSize);

    if i >= Length(ansilargeblock) then
    begin
      iRead := s.Read( ansiblock[1], FBufferSize );
      if iRead < FBufferSize then
      begin
        SetLength(ansiblock,iRead);
      end;

      if iRead = 0 then
      begin
        bEof := True;
      end;

      ansilargeblock := ansilargeblock + ansiblock;
    end;

    {$IFDEF DELPHI2009_UP}
    largeblock := string(ansilargeblock);
    {$ELSE}
    largeblock := ansilargeblock;
    {$ENDIF}

    if not bInMethodDef then
    begin
      iSkip := Length(largeblock);

      largeblocklowercase := LowerCase(largeblock);

      pc := PosEx('constructor ', largeblocklowercase, Max(1, i - 11));
      pd := PosEx('destructor ', largeblocklowercase, Max(1, i - 10));
      pp := PosEx('procedure ', largeblocklowercase, Max(1, i - 9));
      pf := PosEx('function ', largeblocklowercase, Max(1, i - 8));
      largeblocklowercase := '';

      {$IFDEF DELPHI2009_UP}
      if (pc > 2) and not CharInSet(largeblock[pc - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pc > 2) and not (largeblock[pc - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pc + 12, iSkip);
        pc := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pd > 2) and not CharInSet(largeblock[pd - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pd > 2) and not (largeblock[pd - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pd + 11, iSkip);
        pd := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pp > 2) and not CharInSet(largeblock[pp - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pp > 2) and not (largeblock[pp - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pp + 10, iSkip);
        pp := 0;
      end;

      {$IFDEF DELPHI2009_UP}
      if (pf > 2) and not CharInSet(largeblock[pf - 1], [#$0A,#$0D,#$07,#$20]) then
      {$ELSE}
      if (pf > 2) and not (largeblock[pf - 1] in [#$0A,#$0D,#$07,#$20]) then
      {$ENDIF}
      begin
        iSkip := Min(pf + 9, iSkip);
        pf := 0;
      end;

      i := 0;
      if (pc <> 0) then
      begin
        if i = 0 then
        begin
          i := pc;
        end
        else
        begin
          i := Min( i, pc );
        end;
      end;

      if pd <> 0 then
      begin
        if i = 0 then
        begin
          i := pd;
        end
        else
        begin
          i := Min( i, pd );
        end;
      end;

      if pp <> 0 then
      begin
        if i = 0 then
        begin
          i := pp;
        end
        else
        begin
          i := Min( i, pp );
        end;
      end;

      if pf <> 0 then
      begin
        if i = 0 then
        begin
          i := pf;
        end
        else
        begin
          i := Min( i, pf );
        end;
      end;

      if i <> 0 then
      begin
        bInMethodDef := True;
        sMethodDef := '';
      end
      else
      begin
        i := iSkip;
      end;
    end;

    if bInMethodDef then
    begin
      sMethodDef := sMethodDef + largeblock[i];

      if bInParams then
      begin
        if largeblock[i] = ')' then
        begin
          bInParams := False;
        end;
      end
      else
      begin
        if largeblock[i] = '(' then
        begin
          bInParams := True;
        end
        else if largeblock[i] = ';' then
        begin
          bInMethodDef := False;

          fdef := TMethodDefinition.Create(sMethodDef, false, csUnknown);
          if IsValidPascalIdentifier(fdef.DefMethodName) then
          begin
            if bGetLineNumbers then
            begin
              iMethodLineNumber := TCommonStringFunctions.CountLines(largeblock, lfDos, i);
              iMethodDefinitionLineCount := TCommonStringFunctions.CountLines(sMethodDef, lfDos);

              fdef.LineNumber := iAnotherLineOffset + iMethodLineNumber - iMethodDefinitionLineCount;

              iAnotherLineOffset := iAnotherLineOffset + iMethodLineNumber;
            end;

            UpdateMethodBasedOnDefinition(fdef);

            FMethodList.Add( fdef );
          end
          else
          begin
            fdef.Free;

            sMethodDef := '';
          end;

          largeblock := Copy(largeblock, i + 1);
          i := 1;
        end;
      end;

      Inc(i);
    end;
  end;
end;

function TUnitParser.GetCreateCodeFromClass(const sClassName: string): string;
var
  i, c: integer;
  j, d: integer;
  m: TMethodDefinition;
  sParamType: string;
  sParamVal: string;
  sAllParams: string;
  sParentClass: string;
{'fraction_non_alphanumeric': 0.0974513228540009, 'fraction_numerical': 0.01225823145093473, 'mean_word_length': 2.7148864592094197, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '192477', 'n_tokens_mistral': 10311, 'n_tokens_neox': 9656, 'n_words': 2492}