mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 10:39:53 +01:00
fixed mem leak
git-svn-id: trunk@10452 -
This commit is contained in:
mattias
parent
31d77382f8
commit
a8c68262ef
@ -748,6 +748,7 @@ function ExprTypeToString(const ExprType: TExpressionType): string;
|
||||
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
||||
const Context: TFindContext): TExpressionType;
|
||||
|
||||
function FindContextToString(const FindContext: TFindContext): string;
|
||||
function CreateFindContext(NewTool: TFindDeclarationTool;
|
||||
NewNode: TCodeTreeNode): TFindContext;
|
||||
function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
|
||||
@ -915,24 +916,10 @@ begin
|
||||
end;
|
||||
|
||||
function ExprTypeToString(const ExprType: TExpressionType): string;
|
||||
var
|
||||
IdentNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:='Desc='+ExpressionTypeDescNames[ExprType.Desc]
|
||||
+' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc];
|
||||
if ExprType.Context.Node<>nil then begin
|
||||
Result:=Result+' Node='+ExprType.Context.Node.DescAsString;
|
||||
IdentNode:=ExprType.Context.Node;
|
||||
while (IdentNode<>nil) do begin
|
||||
if IdentNode.Desc in AllIdentifierDefinitions then begin
|
||||
Result:=Result+' Ident="'+
|
||||
ExprType.Context.Tool.ExtractIdentifier(IdentNode.StartPos)+'"';
|
||||
break;
|
||||
end;
|
||||
IdentNode:=IdentNode.Parent;
|
||||
end;
|
||||
Result:=Result+' File="'+ExprType.Context.Tool.MainFilename+'"';
|
||||
end;
|
||||
+' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc]
|
||||
+FindContextToString(ExprType.Context);
|
||||
end;
|
||||
|
||||
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
||||
@ -945,6 +932,40 @@ end;
|
||||
|
||||
{ TFindContext }
|
||||
|
||||
function FindContextToString(const FindContext: TFindContext): string;
|
||||
var
|
||||
IdentNode: TCodeTreeNode;
|
||||
Caret: TCodeXYPosition;
|
||||
begin
|
||||
Result:='';
|
||||
if FindContext.Node<>nil then begin
|
||||
Result:=Result+'Node='+FindContext.Node.DescAsString;
|
||||
IdentNode:=FindContext.Node;
|
||||
while (IdentNode<>nil) do begin
|
||||
if IdentNode.Desc in AllIdentifierDefinitions then begin
|
||||
Result:=Result+' Ident="'+
|
||||
FindContext.Tool.ExtractIdentifier(IdentNode.StartPos)+'"';
|
||||
break;
|
||||
end;
|
||||
if IdentNode.Desc=ctnProperty then begin
|
||||
Result:=Result+' PropName="'+
|
||||
FindContext.Tool.ExtractPropName(IdentNode,false)+'"';
|
||||
break;
|
||||
end;
|
||||
IdentNode:=IdentNode.Parent;
|
||||
end;
|
||||
if FindContext.Tool<>nil then begin
|
||||
if FindContext.Tool.CleanPosToCaret(FindContext.Node.StartPos,Caret) then
|
||||
begin
|
||||
Result:=Result+' File='+Caret.Code.Filename
|
||||
+'('+IntToStr(Caret.Y)+','+IntToStr(Caret.X)+')';
|
||||
end else begin
|
||||
Result:=Result+' File="'+FindContext.Tool.MainFilename+'"';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CreateFindContext(NewTool: TFindDeclarationTool;
|
||||
NewNode: TCodeTreeNode): TFindContext;
|
||||
begin
|
||||
|
||||
@ -564,7 +564,6 @@ var
|
||||
begin
|
||||
CreateChildNode(TLFMObjectNode);
|
||||
ObjectNode:=TLFMObjectNode(CurNode);
|
||||
//DebugLn('TLFMTree.ProcessObject A ',Parser.TokenString);
|
||||
if Parser.TokenSymbolIs('OBJECT') then
|
||||
ObjectNode.IsInherited := False
|
||||
else begin
|
||||
@ -573,43 +572,45 @@ begin
|
||||
end;
|
||||
Parser.NextToken;
|
||||
Parser.CheckToken(toSymbol);
|
||||
ObjectStartLine:=Parser.SourceLine;
|
||||
ObjectNode.Name := '';
|
||||
ObjectNode.TypeName := Parser.TokenString;
|
||||
ObjectNode.TypeNamePosition:=Parser.SourcePos+1;
|
||||
ObjectNode.ChildPos := -1;
|
||||
Parser.NextToken;
|
||||
if Parser.Token = ':' then begin
|
||||
Parser.NextToken;
|
||||
Parser.CheckToken(toSymbol);
|
||||
ObjectNode.Name := ObjectNode.TypeName;
|
||||
ObjectNode.NamePosition:=ObjectNode.TypeNamePosition;
|
||||
if not Parser.TokenSymbolIs('END') then begin
|
||||
ObjectStartLine:=Parser.SourceLine;
|
||||
ObjectNode.Name := '';
|
||||
ObjectNode.TypeName := Parser.TokenString;
|
||||
ObjectNode.TypeNamePosition:=Parser.SourcePos+1;
|
||||
ObjectNode.ChildPos := -1;
|
||||
Parser.NextToken;
|
||||
if parser.Token = '[' then begin
|
||||
parser.NextToken;
|
||||
ObjectNode.ChildPos := parser.TokenInt;
|
||||
parser.NextToken;
|
||||
parser.CheckToken(']');
|
||||
parser.NextToken;
|
||||
if Parser.Token = ':' then begin
|
||||
Parser.NextToken;
|
||||
Parser.CheckToken(toSymbol);
|
||||
ObjectNode.Name := ObjectNode.TypeName;
|
||||
ObjectNode.NamePosition:=ObjectNode.TypeNamePosition;
|
||||
ObjectNode.TypeName := Parser.TokenString;
|
||||
ObjectNode.TypeNamePosition:=Parser.SourcePos+1;
|
||||
Parser.NextToken;
|
||||
if parser.Token = '[' then begin
|
||||
parser.NextToken;
|
||||
ObjectNode.ChildPos := parser.TokenInt;
|
||||
parser.NextToken;
|
||||
parser.CheckToken(']');
|
||||
parser.NextToken;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// read property list
|
||||
while not (Parser.TokenSymbolIs('END')
|
||||
or Parser.TokenSymbolIs('OBJECT')
|
||||
or Parser.TokenSymbolIs('INHERITED')) do
|
||||
ProcessProperty;
|
||||
// read property list
|
||||
while not (Parser.TokenSymbolIs('END')
|
||||
or Parser.TokenSymbolIs('OBJECT')
|
||||
or Parser.TokenSymbolIs('INHERITED')) do
|
||||
ProcessProperty;
|
||||
|
||||
// read child objects
|
||||
while not Parser.TokenSymbolIs('END') do begin
|
||||
if Parser.Token=toEOF then begin
|
||||
Parser.Error('END not found for'
|
||||
+' object='+ObjectNode.Name+':'+ObjectNode.TypeName
|
||||
+' starting at line '+IntToStr(ObjectStartLine));
|
||||
// read child objects
|
||||
while not Parser.TokenSymbolIs('END') do begin
|
||||
if Parser.Token=toEOF then begin
|
||||
Parser.Error('END not found for'
|
||||
+' object='+ObjectNode.Name+':'+ObjectNode.TypeName
|
||||
+' starting at line '+IntToStr(ObjectStartLine));
|
||||
end;
|
||||
ProcessObject;
|
||||
end;
|
||||
ProcessObject;
|
||||
end;
|
||||
Parser.NextToken; // Skip 'END' token
|
||||
|
||||
|
||||
@ -1639,15 +1639,37 @@ var
|
||||
Params.ContextNode:=ClassContext.Node;
|
||||
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
||||
try
|
||||
//DebugLn('FindLFMIdentifier A ',
|
||||
// ' Ident=',
|
||||
// '"'+GetIdentifier(Params.Identifier)+'"',
|
||||
// ' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
|
||||
// ' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
|
||||
// ' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
|
||||
// );
|
||||
if CompareIdentifiers('PopupMenu',PChar(Pointer(IdentName)))=0 then
|
||||
DebugLn('FindLFMIdentifier A ',
|
||||
' Ident=',
|
||||
'"'+GetIdentifier(Params.Identifier)+'"',
|
||||
' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
|
||||
' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
|
||||
' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
|
||||
);
|
||||
if ClassContext.Tool.FindIdentifierInContext(Params) then begin
|
||||
IdentContext:=CreateFindContext(Params);
|
||||
repeat
|
||||
IdentContext:=CreateFindContext(Params);
|
||||
if CompareIdentifiers('PopupMenu',PChar(Pointer(IdentName)))=0 then
|
||||
DebugLn(['FindLFMIdentifier ',FindContextToString(IdentContext)]);
|
||||
if (IdentContext.Node<>nil)
|
||||
and (IdentContext.Node.Desc=ctnProperty)
|
||||
and (IdentContext.Tool.PropNodeIsTypeLess(IdentContext.Node)) then
|
||||
begin
|
||||
// this is a typeless property -> search further
|
||||
DebugLn(['FindLFMIdentifier property ',FindContextToString(IdentContext),' is typeless searching further ...']);
|
||||
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
|
||||
fdfExceptionOnPredefinedIdent,
|
||||
fdfIgnoreMissingParams,
|
||||
fdfIgnoreCurContextNode,
|
||||
fdfIgnoreOverloadedProcs];
|
||||
Params.ContextNode:=IdentContext.Node;
|
||||
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
||||
if not IdentContext.Tool.FindIdentifierInContext(Params) then
|
||||
break;
|
||||
end else
|
||||
break;
|
||||
until false;
|
||||
end;
|
||||
except
|
||||
// ignore search/parse errors
|
||||
@ -1818,8 +1840,8 @@ var
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if identifier is variable
|
||||
if (not ChildContext.Node.Desc=ctnVarDefinition) then begin
|
||||
// check if identifier is a variable
|
||||
if (ChildContext.Node.Desc <> ctnVarDefinition) then begin
|
||||
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
||||
LFMObjectName+' is not a variable'
|
||||
+CreateFootNote(ChildContext),
|
||||
@ -1841,8 +1863,9 @@ var
|
||||
if LFMObject.TypeName<>'' then begin
|
||||
VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
|
||||
ChildContext.Node);
|
||||
if (VariableTypeName='')
|
||||
or (AnsiCompareText(VariableTypeName,LFMObject.TypeName)<>0) then begin
|
||||
if (CompareIdentifiers(PChar(VariableTypeName),
|
||||
PChar(LFMObject.TypeName))<>0)
|
||||
then begin
|
||||
ChildContext.Node:=DefinitionNode;
|
||||
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
||||
VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
|
||||
|
||||
@ -362,70 +362,75 @@ var
|
||||
begin
|
||||
Result:=false;
|
||||
ContentChanged:=false;
|
||||
NewContent:=nil;
|
||||
try
|
||||
e:=LineEnding;
|
||||
NewContent:=TMemoryStream.Create;
|
||||
try
|
||||
e:=LineEnding;
|
||||
NewContent:=TMemoryStream.Create;
|
||||
|
||||
// write header - needed by editors like poedit so they know what encoding
|
||||
// to create
|
||||
WriteLine('msgid ""');
|
||||
WriteLine('msgstr ""');
|
||||
WriteLine('"MIME-Version: 1.0\n"');
|
||||
WriteLine('"Content-Type: text/plain; charset=UTF-8\n"');
|
||||
WriteLine('"Content-Transfer-Encoding: 8bit\n"');
|
||||
WriteStr(e);
|
||||
// write header - needed by editors like poedit so they know what encoding
|
||||
// to create
|
||||
WriteLine('msgid ""');
|
||||
WriteLine('msgstr ""');
|
||||
WriteLine('"MIME-Version: 1.0\n"');
|
||||
WriteLine('"Content-Type: text/plain; charset=UTF-8\n"');
|
||||
WriteLine('"Content-Transfer-Encoding: 8bit\n"');
|
||||
WriteStr(e);
|
||||
|
||||
Node:=TreeOfConstItems.FindLowest;
|
||||
while Node<>nil do begin
|
||||
item := TConstItem(Node.Data);
|
||||
Node:=TreeOfConstItems.FindLowest;
|
||||
while Node<>nil do begin
|
||||
item := TConstItem(Node.Data);
|
||||
|
||||
// Convert string to C-style syntax
|
||||
s := '';
|
||||
for j := 1 to Length(item.Value) do begin
|
||||
c := item.Value[j];
|
||||
case c of
|
||||
#9: s := s + '\t';
|
||||
#10: s := s + '\n';
|
||||
#0..#8,#11..#31,#128..#255:
|
||||
s := s + '\' +
|
||||
Chr(Ord(c) shr 6 + 48) +
|
||||
Chr((Ord(c) shr 3) and 7 + 48) +
|
||||
Chr(Ord(c) and 7 + 48);
|
||||
'\': s := s + '\\';
|
||||
'"': s := s + '\"';
|
||||
else s := s + c;
|
||||
// Convert string to C-style syntax
|
||||
s := '';
|
||||
for j := 1 to Length(item.Value) do begin
|
||||
c := item.Value[j];
|
||||
case c of
|
||||
#9: s := s + '\t';
|
||||
#10: s := s + '\n';
|
||||
#0..#8,#11..#31,#128..#255:
|
||||
s := s + '\' +
|
||||
Chr(Ord(c) shr 6 + 48) +
|
||||
Chr((Ord(c) shr 3) and 7 + 48) +
|
||||
Chr(Ord(c) and 7 + 48);
|
||||
'\': s := s + '\\';
|
||||
'"': s := s + '\"';
|
||||
else s := s + c;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Write msg entry
|
||||
WriteStr('#: ');
|
||||
WriteStr(item.ModuleName);
|
||||
WriteStr(':');
|
||||
WriteStr(item.ConstName);
|
||||
WriteStr(e);
|
||||
WriteStr('msgid "');
|
||||
WriteStr(s);
|
||||
WriteStr('"');
|
||||
WriteStr(e);
|
||||
WriteStr('msgstr ""');
|
||||
WriteStr(e);
|
||||
WriteStr(e);
|
||||
|
||||
Node:=TreeOfConstItems.FindSuccessor(Node);
|
||||
end;
|
||||
|
||||
// Write msg entry
|
||||
WriteStr('#: ');
|
||||
WriteStr(item.ModuleName);
|
||||
WriteStr(':');
|
||||
WriteStr(item.ConstName);
|
||||
WriteStr(e);
|
||||
WriteStr('msgid "');
|
||||
WriteStr(s);
|
||||
WriteStr('"');
|
||||
WriteStr(e);
|
||||
WriteStr('msgstr ""');
|
||||
WriteStr(e);
|
||||
WriteStr(e);
|
||||
|
||||
Node:=TreeOfConstItems.FindSuccessor(Node);
|
||||
NewContent.Position:=0;
|
||||
if CheckContentChange and FileExists(OutFilename) then begin
|
||||
OldContent:=TMemoryStream.Create;
|
||||
OldContent.LoadFromFile(OutFilename);
|
||||
ContentChanged:=CompareMemStreamText(NewContent,OldContent);
|
||||
OldContent.Free;
|
||||
end else begin
|
||||
ContentChanged:=true;
|
||||
end;
|
||||
if ContentChanged then
|
||||
NewContent.SaveToFile(OutFilename);
|
||||
Result:=true;
|
||||
finally
|
||||
NewContent.Free;
|
||||
end;
|
||||
|
||||
NewContent.Position:=0;
|
||||
if CheckContentChange and FileExists(OutFilename) then begin
|
||||
OldContent:=TMemoryStream.Create;
|
||||
OldContent.LoadFromFile(OutFilename);
|
||||
ContentChanged:=CompareMemStreamText(NewContent,OldContent);
|
||||
OldContent.Free;
|
||||
end else begin
|
||||
ContentChanged:=true;
|
||||
end;
|
||||
if ContentChanged then
|
||||
NewContent.SaveToFile(OutFilename);
|
||||
Result:=true;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn(['ConvertToGettextPO ',E.Message]);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user