paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 21:39:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Don't cut a dotted TargetFilename when adding an extension to it. Issue #34665.

Browse Source 
git-svn-id: trunk@64070 -
This commit is contained in:
juha 2020-10-24 19:59:57 +00:00
parent 5ec8bc5d98
commit 609f5046d8
1 changed files with 42 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
ide/compileroptions.pp
View File

@ -414,8 +414,10 @@ type
FOtherDefines: TStrings; // list of user selectable defines for custom options FOtherDefines: TStrings; // list of user selectable defines for custom options
FFPCMsgFile: TFPCMsgFilePoolItem; FFPCMsgFile: TFPCMsgFilePoolItem;
FCreateMakefileOnBuild: boolean; FCreateMakefileOnBuild: boolean;
procedure AppendDefaultExt(var aFilename: string);
function GetExecuteAfter: TCompilationToolOptions; function GetExecuteAfter: TCompilationToolOptions;
function GetExecuteBefore: TCompilationToolOptions; function GetExecuteBefore: TCompilationToolOptions;
procedure PrependDefaultType(var AFilename: string);
procedure SetCreateMakefileOnBuild(AValue: boolean); procedure SetCreateMakefileOnBuild(AValue: boolean);
protected protected
function GetCompilerPath: String; override; function GetCompilerPath: String; override;
@ -1940,66 +1942,51 @@ begin
end; end;
end; end;
{------------------------------------------------------------------------------ procedure TBaseCompilerOptions.AppendDefaultExt(var aFilename: string);
TBaseCompilerOptions CreateTargetFilename
------------------------------------------------------------------------------}
function TBaseCompilerOptions.CreateTargetFilename: string;
procedure AppendDefaultExt(var aFilename: string);
var
Ext: String;
begin
if (ExtractFileName(aFilename)='') then exit;
Ext:=GetTargetFileExt;
if Ext<>'' then begin
aFilename:=ChangeFileExt(aFilename,Ext);
//debugln ( 'Filename is ',AFilename,' in AppendDefaultExt' );
exit;
end;
end;
procedure PrependDefaultType(var AFilename: string);
var
Prefix: String;
FileName: String;
PathName: String;
CurTargetOS: String;
aSrcOS: String;
begin
//debugln ( 'Filename AFilename is ',AFilename, ' in PrependDefaultType' );
if (ExtractFileName(AFilename)='')
or (CompareText(copy(ExtractFileName(AFilename),1,3), 'lib') = 0) then exit;
Prefix:=GetTargetFilePrefix;
if Prefix<>'' then begin
FileName := ExtractFileName(AFilename);
PathName := ExtractFilePath(AFilename);
//debugln ( 'Filename is ',FileName, ' in PrependDefaultType' );
CurTargetOS:=TargetOS;
if CurTargetOS='' then CurTargetOS:=GetCompiledTargetOS;
aSrcOS:=GetDefaultSrcOSForTargetOS(CurTargetOS);
if (CompareText(aSrcOS, 'unix') = 0)
then begin
AFilename:=PathName+Prefix+UTF8LowerCase(FileName);
end else begin
AFilename:=PathName+Prefix+FileName;
end;
//debugln ( 'AFilename is ',AFilename, ' in PrependDefaultType' );
exit;
end;
end;
var var
UnitOutDir: String; Ext: String;
OutFilename: String; begin
Dir: String; if ExtractFileName(aFilename)='' then exit;
Ext:=GetTargetFileExt;
if (Ext<>'') and (CompareFileExt(aFilename,Ext)<>0) then
aFilename:=aFilename+Ext;
//DebugLn('Filename is ',AFilename,' in AppendDefaultExt');
end;
procedure TBaseCompilerOptions.PrependDefaultType(var AFilename: string);
var
Prefix, FileName, PathName, CurTargetOS, aSrcOS: String;
begin
//DebugLn('Filename AFilename is ',AFilename, ' in PrependDefaultType');
if (ExtractFileName(AFilename)='')
or (CompareText(copy(ExtractFileName(AFilename),1,3), 'lib') = 0) then exit;
Prefix:=GetTargetFilePrefix;
if Prefix<>'' then
begin
FileName := ExtractFileName(AFilename);
PathName := ExtractFilePath(AFilename);
//debugln ( 'Filename is ',FileName, ' in PrependDefaultType' );
CurTargetOS:=TargetOS;
if CurTargetOS='' then CurTargetOS:=GetCompiledTargetOS;
aSrcOS:=GetDefaultSrcOSForTargetOS(CurTargetOS);
if CompareText(aSrcOS, 'unix') = 0 then
AFilename:=PathName+Prefix+UTF8LowerCase(FileName)
else
AFilename:=PathName+Prefix+FileName;
//DebugLn('AFilename is ',AFilename, ' in PrependDefaultType');
exit;
end;
end;
function TBaseCompilerOptions.CreateTargetFilename: string;
var
UnitOutDir, OutFilename, Dir: String;
begin begin
Result:=TargetFilename; Result:=TargetFilename;
if Assigned(ParsedOpts.OnLocalSubstitute) then if Assigned(ParsedOpts.OnLocalSubstitute) then
begin Result:=ParsedOpts.OnLocalSubstitute(Result,false)
Result:=ParsedOpts.OnLocalSubstitute(Result,false); else
end else begin
Result:=ParseString(ParsedOpts,Result,false); Result:=ParseString(ParsedOpts,Result,false);
end;
if (Result<>'') and FilenameIsAbsolute(Result) then begin if (Result<>'') and FilenameIsAbsolute(Result) then begin
// fully specified target filename // fully specified target filename
end else if Result<>'' then begin end else if Result<>'' then begin