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

* Optimize ExtractFileUnitName

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-09-25 14:23:30 +02:00
parent 2123c59941
commit 5769d737d1
1 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
packages/fcl-passrc/src/pscanner.pp
View File

@ -1325,7 +1325,7 @@ function FilenameIsWinAbsolute(const TheFilename: String): boolean;
function FilenameIsUnixAbsolute(const TheFilename: String): boolean;
function IsNamedToken(Const AToken : TPasScannerString; Out T : TToken) : Boolean;
Function ExtractFilenameOnly(Const AFileName : String) : String;
function ExtractFileUnitName(aFilename: String): String;
function ExtractFileUnitName(const aFilename: String): String;
procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
function SafeFormat(const Fmt: String; Args: array of const): String;
@ -1337,6 +1337,12 @@ procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
implementation
uses
{$IFDEF FPC_DOTTEDUNITS}
System.StrUtils;
{$ELSE}
strutils;
{$ENDIF}
const
IdentChars = ['0'..'9', 'A'..'Z', 'a'..'z','_'];
Digits = ['0'..'9'];
@ -1354,21 +1360,16 @@ begin
Result:=ChangeFileExt(ExtractFileName(aFileName),'');
end;
function ExtractFileUnitName(aFilename: String): String;
function ExtractFileUnitName(const aFilename: String): String;
var
p: Integer;
begin
Result:=ExtractFileName(aFilename);
if Result='' then exit;
for p:=length(Result) downto 1 do
case Result[p] of
'/','\': exit;
'.':
begin
SetLength(Result, p-1);
exit;
end;
end;
if Result='' then
exit;
p:=rpos('.',Result);
if p>0 then
SetLength(Result, p-1);
end;
Procedure SortTokenInfo;