mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-09 19:39:31 +01:00
fixed mem leak
git-svn-id: trunk@10452 -
This commit is contained in:
parent
31d77382f8
commit
a8c68262ef
@ -748,6 +748,7 @@ function ExprTypeToString(const ExprType: TExpressionType): string;
|
|||||||
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
||||||
const Context: TFindContext): TExpressionType;
|
const Context: TFindContext): TExpressionType;
|
||||||
|
|
||||||
|
function FindContextToString(const FindContext: TFindContext): string;
|
||||||
function CreateFindContext(NewTool: TFindDeclarationTool;
|
function CreateFindContext(NewTool: TFindDeclarationTool;
|
||||||
NewNode: TCodeTreeNode): TFindContext;
|
NewNode: TCodeTreeNode): TFindContext;
|
||||||
function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
|
function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
|
||||||
@ -915,24 +916,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function ExprTypeToString(const ExprType: TExpressionType): string;
|
function ExprTypeToString(const ExprType: TExpressionType): string;
|
||||||
var
|
|
||||||
IdentNode: TCodeTreeNode;
|
|
||||||
begin
|
begin
|
||||||
Result:='Desc='+ExpressionTypeDescNames[ExprType.Desc]
|
Result:='Desc='+ExpressionTypeDescNames[ExprType.Desc]
|
||||||
+' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc];
|
+' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc]
|
||||||
if ExprType.Context.Node<>nil then begin
|
+FindContextToString(ExprType.Context);
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
|
||||||
@ -945,6 +932,40 @@ end;
|
|||||||
|
|
||||||
{ TFindContext }
|
{ 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;
|
function CreateFindContext(NewTool: TFindDeclarationTool;
|
||||||
NewNode: TCodeTreeNode): TFindContext;
|
NewNode: TCodeTreeNode): TFindContext;
|
||||||
begin
|
begin
|
||||||
|
|||||||
@ -564,7 +564,6 @@ var
|
|||||||
begin
|
begin
|
||||||
CreateChildNode(TLFMObjectNode);
|
CreateChildNode(TLFMObjectNode);
|
||||||
ObjectNode:=TLFMObjectNode(CurNode);
|
ObjectNode:=TLFMObjectNode(CurNode);
|
||||||
//DebugLn('TLFMTree.ProcessObject A ',Parser.TokenString);
|
|
||||||
if Parser.TokenSymbolIs('OBJECT') then
|
if Parser.TokenSymbolIs('OBJECT') then
|
||||||
ObjectNode.IsInherited := False
|
ObjectNode.IsInherited := False
|
||||||
else begin
|
else begin
|
||||||
@ -573,6 +572,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
Parser.NextToken;
|
Parser.NextToken;
|
||||||
Parser.CheckToken(toSymbol);
|
Parser.CheckToken(toSymbol);
|
||||||
|
if not Parser.TokenSymbolIs('END') then begin
|
||||||
ObjectStartLine:=Parser.SourceLine;
|
ObjectStartLine:=Parser.SourceLine;
|
||||||
ObjectNode.Name := '';
|
ObjectNode.Name := '';
|
||||||
ObjectNode.TypeName := Parser.TokenString;
|
ObjectNode.TypeName := Parser.TokenString;
|
||||||
@ -611,6 +611,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
ProcessObject;
|
ProcessObject;
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
Parser.NextToken; // Skip 'END' token
|
Parser.NextToken; // Skip 'END' token
|
||||||
|
|
||||||
CloseChildNode;
|
CloseChildNode;
|
||||||
|
|||||||
@ -1639,15 +1639,37 @@ var
|
|||||||
Params.ContextNode:=ClassContext.Node;
|
Params.ContextNode:=ClassContext.Node;
|
||||||
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
|
||||||
try
|
try
|
||||||
//DebugLn('FindLFMIdentifier A ',
|
if CompareIdentifiers('PopupMenu',PChar(Pointer(IdentName)))=0 then
|
||||||
// ' Ident=',
|
DebugLn('FindLFMIdentifier A ',
|
||||||
// '"'+GetIdentifier(Params.Identifier)+'"',
|
' Ident=',
|
||||||
// ' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
|
'"'+GetIdentifier(Params.Identifier)+'"',
|
||||||
// ' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
|
' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
|
||||||
// ' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
|
' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
|
||||||
// );
|
' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
|
||||||
|
);
|
||||||
if ClassContext.Tool.FindIdentifierInContext(Params) then begin
|
if ClassContext.Tool.FindIdentifierInContext(Params) then begin
|
||||||
|
repeat
|
||||||
IdentContext:=CreateFindContext(Params);
|
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;
|
end;
|
||||||
except
|
except
|
||||||
// ignore search/parse errors
|
// ignore search/parse errors
|
||||||
@ -1818,8 +1840,8 @@ var
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// check if identifier is variable
|
// check if identifier is a variable
|
||||||
if (not ChildContext.Node.Desc=ctnVarDefinition) then begin
|
if (ChildContext.Node.Desc <> ctnVarDefinition) then begin
|
||||||
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
||||||
LFMObjectName+' is not a variable'
|
LFMObjectName+' is not a variable'
|
||||||
+CreateFootNote(ChildContext),
|
+CreateFootNote(ChildContext),
|
||||||
@ -1841,8 +1863,9 @@ var
|
|||||||
if LFMObject.TypeName<>'' then begin
|
if LFMObject.TypeName<>'' then begin
|
||||||
VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
|
VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
|
||||||
ChildContext.Node);
|
ChildContext.Node);
|
||||||
if (VariableTypeName='')
|
if (CompareIdentifiers(PChar(VariableTypeName),
|
||||||
or (AnsiCompareText(VariableTypeName,LFMObject.TypeName)<>0) then begin
|
PChar(LFMObject.TypeName))<>0)
|
||||||
|
then begin
|
||||||
ChildContext.Node:=DefinitionNode;
|
ChildContext.Node:=DefinitionNode;
|
||||||
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
|
||||||
VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
|
VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
|
||||||
|
|||||||
@ -362,6 +362,8 @@ var
|
|||||||
begin
|
begin
|
||||||
Result:=false;
|
Result:=false;
|
||||||
ContentChanged:=false;
|
ContentChanged:=false;
|
||||||
|
NewContent:=nil;
|
||||||
|
try
|
||||||
try
|
try
|
||||||
e:=LineEnding;
|
e:=LineEnding;
|
||||||
NewContent:=TMemoryStream.Create;
|
NewContent:=TMemoryStream.Create;
|
||||||
@ -426,6 +428,9 @@ begin
|
|||||||
if ContentChanged then
|
if ContentChanged then
|
||||||
NewContent.SaveToFile(OutFilename);
|
NewContent.SaveToFile(OutFilename);
|
||||||
Result:=true;
|
Result:=true;
|
||||||
|
finally
|
||||||
|
NewContent.Free;
|
||||||
|
end;
|
||||||
except
|
except
|
||||||
on E: Exception do begin
|
on E: Exception do begin
|
||||||
DebugLn(['ConvertToGettextPO ',E.Message]);
|
DebugLn(['ConvertToGettextPO ',E.Message]);
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user