Speicherlücken

[Warf]

Hey ho,
im Zuge eines Projektes habe ich eine Klasse geschrieben die Integer defines aus c/c++ Header Dateien ausliest. Aus irgend einem Grund habe ich da allerdings ein Haufen Memoryleaks, ich sehe aber nicht warum. Vielleicht sieht einer von euch den Fehler

Code: Alles auswählen

unit ConstantReader;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, MyTypes, strutils;
 
type
  TConstReader = class
  private
    Consts: TList;
    procedure Clear;
    function GetConst(i: integer): TDefineConst;
    procedure SetConst(i: integer; c: TDefineConst);
    function getCount: integer;
  public
    property Constants[i: integer]: TDefineConst read GetConst write SetConst; default;
    property Count: integer read GetCount;
    function GetConstByKey(AKey: string): TDefineConst;
    function GetKeyByVal(Val: integer): string; overload;
    function GetKeyByVal(Val: cardinal): string; overload;
    function GetKeyByVal(Val: longword; Prefix: string): string; overload;
    procedure Read(Data: TBytes; preFix: string);
    constructor Create;
    destructor Destroy; override;
  end;
 
implementation
 
 
function TConstReader.GetKeyByVal(Val: integer): string;
var
  i: integer;
begin
  for i := 0 to Consts.Count - 1 do
    if GetConst(i).Value = Val then
    begin
      Result := GetConst(i).Key;
    end;
end;
 
function TConstReader.GetKeyByVal(Val: longword; Prefix: string): string;
var
  i: integer;
begin
  Result := '=';
  for i := 0 to Consts.Count - 1 do
    if (GetConst(i).Value = Val) and (AnsiStartsStr(Prefix, GetConst(i).Key)) then
    begin
      Result := GetConst(i).Key;
    end;
end;
 
function TConstReader.GetKeyByVal(Val: cardinal): string;
var
  i: integer;
begin
  for i := 0 to Consts.Count - 1 do
    if GetConst(i).uValue = Val then
    begin
      Result := GetConst(i).Key;
    end;
end;
 
function TConstReader.getCount: integer;
begin
  Result := Consts.Count;
end;
 
function TConstReader.GetConst(i: integer): TDefineConst;
begin
  Result := PDefineConst(Consts[i])^;
end;
 
procedure TConstReader.SetConst(i: integer; c: TDefineConst);
begin
  PDefineConst(Consts[i])^ := c;
end;
 
procedure TConstReader.Clear;
var
  i: integer;
begin
  for i := 0 to Consts.Count - 1 do
    Dispose(PDefineConst(Consts[i]));
  Consts.Clear;
end;
 
function TConstReader.GetConstByKey(AKey: string): TDefineConst;
var
  i: integer;
begin
  FillChar(Result, SizeOf(Result), $00);
  Result.Value := -1;
  for i := 0 to Consts.Count - 1 do
    if Assigned(PDefineConst(Consts[i])) then
      if PDefineConst(Consts[i])^.Key = AKey then
      begin
        Result := PDefineConst(Consts[i])^;
        Break;
      end;
end;
 
procedure TConstReader.Read(Data: TBytes; preFix: string);
type
  TStr3Arr = array[0..2] of string;
 
  procedure AddConst(c: TDefineConst);
  var
    tmp: PDefineConst;
  begin
    new(tmp);
    tmp^ := c;
    Consts.Add(tmp);
  end;
 
  function BytesToString(b: TBytes): string;
  var
    i: word;
    s: string;
    w: WideString;
    isUnicode: boolean;
  begin
    i := 0;
    Move(b[0], i, 2);
    isUnicode := i <> $FEFF;
    if isUnicode then
      SetString(s, PAnsiChar(@b[0]), Length(b))
    else
    begin
      SetString(w, PWideChar(@b[2]), Length(b) div 2);
      s := w;
    end;
    Result := s;
  end;
 
  function ReadLine(ln: string; out dat: TStr3Arr): boolean;
  var
    p: PChar;
    curr: byte;
    len: integer;
    overflow: string;
  begin
    SetLength(dat[0], 255);
    FillChar(dat[0][1], 255, #00);
    SetLength(dat[1], 255);
    FillChar(dat[1][1], 255, #00);
    SetLength(dat[2], 255);
    FillChar(dat[2][1], 255, #00);
    SetLength(overflow, 255);
    FillChar(overflow[1], 255, #00);
    curr := 0;
    len := 0;
    p := PChar(ln);
    while p^ <> #00 do
    begin
      if (p^ = '/') and (PChar(p + SizeOf(char))^ = '/') then
        Break
      else if p^ in [#9, ' '] then
      begin
        if len = 0 then
        begin
          Inc(p, SizeOf(char));
          Continue;
        end;
        if curr <= 2 then
          SetLength(dat[curr], len);
        len := 0;
        Inc(curr);
      end
      else
      begin
        if curr <= 2 then
          dat[curr][len + 1] := p^
        else
          overflow[len + 1] := p^;
        Inc(len);
      end;
      Inc(p, SizeOf(char));
    end;
    SetLength(overflow, len);
    dat[0] := Trim(dat[0]);
    dat[1] := Trim(dat[1]);
    dat[2] := Trim(dat[2]);
    overflow := Trim(overflow);
    Result := ((curr >= 2) and (Trim(overflow) = '')) and (dat[0] <> '') and
      (dat[1] <> '') and (dat[2] <> '');
  end;
 
  function ReadInt(s: string; out val: integer): boolean;
  begin
    if AnsiStartsStr('0x', s) then
    begin
      Result := True;
      val := Hex2Dec(Copy(s, 3, Length(s) - 2));
    end
    else
      Result := TryStrToInt(s, val);
  end;
 
  procedure ReadConst(s: TStr3Arr);
  var
    tmp: TDefineConst;
  begin
    if (s[0] = '#define') and ((preFix = '') or AnsiStartsStr(preFix, s[1])) then
    begin
      tmp.Key := s[1];
      if ReadInt(s[2], tmp.Value) then
        AddConst(tmp);
    end;
  end;
 
  function DeleteMLComments(str: string): string;
  var
    inComment: boolean;
    p1, p2: PChar;
    len: integer;
  begin
    len := 0;
    SetLength(Result, Length(str));
    FillChar(Result[1], Length(Result) * SizeOf(char), #00);
    p1 := PChar(str);
    p2 := @Result[1];
    inComment := False;
    while p1^ <> #0 do
    begin
      if inComment then
      begin
        if (p1^ = '*') and (PChar(p1 + SizeOf(char))^ = '/') then
        begin
          inComment := False;
          Inc(p1);
        end;
      end
      else
      if (p1^ = '/') and (PChar(p1 + SizeOf(char))^ = '*') then
      begin
        inComment := True;
        Inc(p1);
      end
      else
      begin
        p2^ := p1^;
        Inc(p2);
        Inc(len);
      end;
      Inc(p1);
    end;
    SetLength(Result, len);
  end;
 
var
  lst: TStringList;
  i: integer;
  d: TStr3Arr;
begin
  lst := TStringList.Create;
  try
    lst.Text := DeleteMLComments(BytesToString(Data));
    for i := 0 to lst.Count - 1 do
      if ReadLine(Trim(lst[i]), d) then
        ReadConst(d);
  finally
    lst.Free;
  end;
end;
 
constructor TConstReader.Create;
begin
  Consts := TList.Create;
end;
 
destructor TConstReader.Destroy;
begin
  Clear;
  Consts.Free;
  inherited;
end;
 
end.

[Socke]

Die Unit heaptrc protokolliert mit, wo der Speicher angefordert wurde. Du kannst die Unit ganz einfach über die Projektoptionen einbinden.

[wp_xyz]

Bist du sicher, dass die Speicherlecks in dieser Unit entstehen? In die übliche Falle, den durch die Elemente von TList angeforderten Speicher nicht mehr freizugeben, bist du m.E. nicht getappt, weil dieser durch dein "Clear" wieder aufgeräumt wird, und "Clear" rufst du im Destructor auf. Dann sind mir noch die FillChar-Aufrufe aufgefallen; diese führen zu Speicherlecks, wenn sie Records mit String-Elementen ausradieren und dabei den Referenzzähler der Strings überschreiben - aber du löschst damit nur den Zeichenbereich der Strings.

Noch eine Bemerkung: Die Funktion "ReadInt" kannst du stark vereinfachen, weil das gute alte TryStrToInt auch mit dem '0x' umgehen kann. Also:

Code: Alles auswählen

 
function ReadInt(s:String; out val:Integer): Boolean;
begin
  Result := TryStrToInt(s, val);  // geht auch für s='$FF' oder s='0xFF'
end;

[Warf]

Die Unit heaptrc protokolliert mit, wo der Speicher angefordert wurde. Du kannst die Unit ganz einfach über die Projektoptionen einbinden.

Hab ich gemacht nur die angegebene Zeile 243:

Code: Alles auswählen

      if ReadLine(Trim(lst[i]), d) then

ist nicht grade aufschlussreich.

Noch eine Bemerkung: Die Funktion "ReadInt" kannst du stark vereinfachen, weil das gute alte TryStrToInt auch mit dem '0x' umgehen kann. Also:

Code: Alles auswählen

 
function ReadInt(s:String; out val:Integer): Boolean;
begin
  Result := TryStrToInt(s, val);  // geht auch für s='$FF' oder s='0xFF'
end;

Wieder was gelernt

[wp_xyz]

Wenn ich dich da richtig verstanden habe, wird die Zeile 243 von heaptrc als Ursache des Speicherlecks angezeigt. Mach mal die üblichen Range/Overflow etc checks an, vielleicht wird der zulässige Indexbereich für das String-Array d überschritten. Ansonsten solltest du ein kleines Testprogramm schreiben, das eine typische Datei als Stringliste einliest, wobei dann die fragliche Routine ReadLine genauso für alle Strings durchlaufen wird. Dieses, zusammen mit der Testdatei, hier posten. Dann kann man konkret helfen, ansonst muss man nur raten.

[Warf]

Hat sich erledigt, das Problem war ein eine Zeile, die ich nicht mal mehr brauchte, allerdings noch nicht gelöscht habe:

Code: Alles auswählen

function TConstReader.GetConstByKey(AKey: string): TDefineConst;
var
  i: integer;
begin
  FillChar(Result, SizeOf(Result), $00); // Hier
  Result.Value := -1;
  for i := 0 to Consts.Count - 1 do
    if Assigned(PDefineConst(Consts[i])) then
      if PDefineConst(Consts[i])^.Key = AKey then
      begin
        Result := PDefineConst(Consts[i])^;
        Break;
      end;
end;

Das fillchar hatte ich ursprünglich drin da ich noch Boolean Felder record hatte, und alle mit 0 initialisiert hatte, dann aber gemerkt habe dass ich nie negative werte Zuweisen werde und daher ich das mit dem Result.Value = -1 lösen konnte