mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 15:09:36 +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