paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 14:59:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed memleak on published var completion from Vincent

Browse Source 
git-svn-id: trunk@4998 -
This commit is contained in:
mattias 2004-01-03 12:17:25 +00:00
parent 7c8f973a48
commit 37a33a8594
1 changed files with 98 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
components/codetools/eventcodetool.pas
View File

@ -548,56 +548,60 @@ var
CleanMethodDefinition, MethodDefinition: string; CleanMethodDefinition, MethodDefinition: string;
FindContext: TFindContext; FindContext: TFindContext;
begin begin
Result:=false; try
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='') Result:=false;
or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit; if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='')
{$IFDEF CTDEBUG} or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
writeln('[TEventsCodeTool.CreatePublishedMethod] A AMethodName="',AMethodName,'" in "',MainFilename,'"');
{$ENDIF}
// search typeinfo in source
FindContext:=FindMethodTypeInfo(ATypeInfo);
// initialize class for code completion
CodeCompleteClassNode:=ClassNode;
CodeCompleteSrcChgCache:=SourceChangeCache;
// check if method definition already exists in class
CleanMethodDefinition:=UpperCaseStr(AMethodName)
+FindContext.Tool.ExtractProcHead(FindContext.Node,
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
{$IFDEF CTDEBUG} {$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] insert method definition to class'); writeln('[TEventsCodeTool.CreatePublishedMethod] A AMethodName="',AMethodName,'" in "',MainFilename,'"');
{$ENDIF} {$ENDIF}
// insert method definition into class // search typeinfo in source
MethodDefinition:=TrimCodeSpace(FindContext.Tool.ExtractProcHead( FindContext:=FindMethodTypeInfo(ATypeInfo);
FindContext.Node, // initialize class for code completion
[phpWithStart, phpWithoutClassKeyword, phpWithoutClassName, CodeCompleteClassNode:=ClassNode;
phpWithoutName, phpWithVarModifiers, phpWithParameterNames, CodeCompleteSrcChgCache:=SourceChangeCache;
phpWithDefaultValues, phpWithResultType])); // check if method definition already exists in class
MethodDefinition:=SourceChangeCache.BeautifyCodeOptions. CleanMethodDefinition:=UpperCaseStr(AMethodName)
AddClassAndNameToProc(MethodDefinition, '', AMethodName); +FindContext.Tool.ExtractProcHead(FindContext.Node,
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] insert method definition to class');
{$ENDIF}
// insert method definition into class
MethodDefinition:=TrimCodeSpace(FindContext.Tool.ExtractProcHead(
FindContext.Node,
[phpWithStart, phpWithoutClassKeyword, phpWithoutClassName,
phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
phpWithDefaultValues, phpWithResultType]));
MethodDefinition:=SourceChangeCache.BeautifyCodeOptions.
AddClassAndNameToProc(MethodDefinition, '', AMethodName);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] MethodDefinition="',MethodDefinition,'"');
{$ENDIF}
AddClassInsertion(nil, CleanMethodDefinition, MethodDefinition, AMethodName,
'', ncpPublishedProcs);
end;
{$IFDEF CTDEBUG} {$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] MethodDefinition="',MethodDefinition,'"'); writeln('[TEventsCodeTool.CreatePublishedMethod] invoke class completion');
{$ENDIF} {$ENDIF}
AddClassInsertion(nil, CleanMethodDefinition, MethodDefinition, AMethodName, if not InsertAllNewClassParts then
'', ncpPublishedProcs); RaiseException(ctsErrorDuringInsertingNewClassParts);
// insert all missing proc bodies
if not CreateMissingProcBodies then
RaiseException(ctsErrorDuringCreationOfNewProcBodies);
// apply the changes
if not SourceChangeCache.Apply then
RaiseException(ctsUnableToApplyChanges);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] END');
{$ENDIF}
Result:=true;
finally
FreeClassInsertionList;
end; end;
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] invoke class completion');
{$ENDIF}
if not InsertAllNewClassParts then
RaiseException(ctsErrorDuringInsertingNewClassParts);
// insert all missing proc bodies
if not CreateMissingProcBodies then
RaiseException(ctsErrorDuringCreationOfNewProcBodies);
// apply the changes
if not SourceChangeCache.Apply then
RaiseException(ctsUnableToApplyChanges);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CreatePublishedMethod] END');
{$ENDIF}
Result:=true;
end; end;
function TEventsCodeTool.CreateExprListFromMethodTypeData( function TEventsCodeTool.CreateExprListFromMethodTypeData(
@ -720,53 +724,57 @@ var
UpperCurComponentName: String; UpperCurComponentName: String;
VarType: String; VarType: String;
begin begin
Result:=false; try
BuildTree(false); Result:=false;
if not EndOfSourceFound then exit; BuildTree(false);
UpperClassName:=UpperCaseStr(AComponent.ClassName); if not EndOfSourceFound then exit;
{ $IFDEF CTDEBUG} UpperClassName:=UpperCaseStr(AComponent.ClassName);
writeln('[TEventsCodeTool.CompleteComponent] A Component="',AComponent.Name,':',AComponent.ClassName); { $IFDEF CTDEBUG}
{ $ENDIF} writeln('[TEventsCodeTool.CompleteComponent] A Component="',AComponent.Name,':',AComponent.ClassName);
// initialize class for code completion { $ENDIF}
CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true); // initialize class for code completion
CodeCompleteSrcChgCache:=SourceChangeCache; CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
// complete all child components CodeCompleteSrcChgCache:=SourceChangeCache;
for i:=0 to AComponent.ComponentCount-1 do begin // complete all child components
CurComponent:=AComponent.Components[i]; for i:=0 to AComponent.ComponentCount-1 do begin
writeln('[TEventsCodeTool.CompleteComponent] CurComponent=',CurComponent.Name,':',CurComponent.ClassName); CurComponent:=AComponent.Components[i];
VarName:=CurComponent.Name; writeln('[TEventsCodeTool.CompleteComponent] CurComponent=',CurComponent.Name,':',CurComponent.ClassName);
if VarName='' then continue; VarName:=CurComponent.Name;
UpperCurComponentName:=UpperCaseStr(VarName); if VarName='' then continue;
VarType:=CurComponent.ClassName; UpperCurComponentName:=UpperCaseStr(VarName);
// add missing published variable VarType:=CurComponent.ClassName;
if VarExistsInCodeCompleteClass(UpperCurComponentName) then begin // add missing published variable
end else begin if VarExistsInCodeCompleteClass(UpperCurComponentName) then begin
writeln('[TEventsCodeTool.CompleteComponent] ADDING variable ',CurComponent.Name,':',CurComponent.ClassName); end else begin
AddClassInsertion(nil,UpperCurComponentName, writeln('[TEventsCodeTool.CompleteComponent] ADDING variable ',CurComponent.Name,':',CurComponent.ClassName);
VarName+':'+VarType+';',VarName,'',ncpPublishedVars); AddClassInsertion(nil,UpperCurComponentName,
VarName+':'+VarType+';',VarName,'',ncpPublishedVars);
end;
// remove missing published events
// ToDo
end; end;
// remove missing published events { $IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CompleteComponent] invoke class completion');
// ToDo { $ENDIF}
if not InsertAllNewClassParts then
RaiseException(ctsErrorDuringInsertingNewClassParts);
// insert all missing proc bodies
if not CreateMissingProcBodies then
RaiseException(ctsErrorDuringCreationOfNewProcBodies);
// apply the changes
if not SourceChangeCache.Apply then
RaiseException(ctsUnableToApplyChanges);
{ $IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CompleteComponent] END');
{ $ENDIF}
Result:=true;
finally
FreeClassInsertionList;
end; end;
{ $IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CompleteComponent] invoke class completion');
{ $ENDIF}
if not InsertAllNewClassParts then
RaiseException(ctsErrorDuringInsertingNewClassParts);
// insert all missing proc bodies
if not CreateMissingProcBodies then
RaiseException(ctsErrorDuringCreationOfNewProcBodies);
// apply the changes
if not SourceChangeCache.Apply then
RaiseException(ctsUnableToApplyChanges);
{ $IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CompleteComponent] END');
{ $ENDIF}
Result:=true;
end; end;
function TEventsCodeTool.FindIdentifierNodeInClass(ClassNode: TCodeTreeNode; function TEventsCodeTool.FindIdentifierNodeInClass(ClassNode: TCodeTreeNode;