paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 22:10:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* AllowDirectorySeparators and AllowDriveSeparators typed constants

Browse Source 
added to allow customization of path and directory parsing in the rtl
  * Use the new sets instead of the hardcoded / and \

git-svn-id: trunk@10105 -
This commit is contained in:
peter 2008-01-29 23:04:56 +00:00
parent 3d319a99b8
commit f4f3ae84d0
49 changed files with 244 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/amiga/dos.pp
View File

@ -122,8 +122,8 @@ procedure Amiga2DateStamp(Date : LongInt; var TotalDays,Minutes,Ticks: longint);
{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format } { Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
{ Taken from SWAG and modified to work with the Amiga format - CEC } { Taken from SWAG and modified to work with the Amiga format - CEC }
var var
LocalDate : LongInt; LocalDate : LongInt;
Done : Boolean; Done : Boolean;
TotDays : Integer; TotDays : Integer;
Y: Word; Y: Word;
H: Word; H: Word;
@ -183,7 +183,7 @@ begin
end; end;
function dosSetFileDate(name: string; p : PDateStamp): Boolean; function dosSetFileDate(name: string; p : PDateStamp): Boolean;
var var
buffer : array[0..255] of Char; buffer : array[0..255] of Char;
begin begin
move(name[1],buffer,length(name)); move(name[1],buffer,length(name));
@ -448,7 +448,7 @@ begin
DosError:= 0; DosError:= 0;
LastDosExitCode:=0; LastDosExitCode:=0;
tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :) tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :)
{ Here we must first check if the command we wish to execute } { Here we must first check if the command we wish to execute }
{ actually exists, because this is NOT handled by the } { actually exists, because this is NOT handled by the }
{ _SystemTagList call (program will abort!!) } { _SystemTagList call (program will abort!!) }
@ -726,8 +726,7 @@ begin
DosError:=0; DosError:=0;
FTime := 0; FTime := 0;
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(Str);
if str[i]='\' then str[i]:='/';
FLock := dosLock(Str, SHARED_LOCK); FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then begin IF FLock <> 0 then begin
New(FInfo); New(FInfo);
@ -758,8 +757,7 @@ end;
Begin Begin
new(DateStamp); new(DateStamp);
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(str);
if str[i]='\' then str[i]:='/';
{ Check first of all, if file exists } { Check first of all, if file exists }
FLock := dosLock(Str, SHARED_LOCK); FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then IF FLock <> 0 then
@ -791,8 +789,7 @@ begin
flags:=0; flags:=0;
New(info); New(info);
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(str);
if str[i]='\' then str[i]:='/';
{ open with shared lock to check if file exists } { open with shared lock to check if file exists }
MyLock:=dosLock(Str,SHARED_LOCK); MyLock:=dosLock(Str,SHARED_LOCK);
if MyLock <> 0 then if MyLock <> 0 then
@ -853,7 +850,7 @@ end;
--- Environment --- --- Environment ---
******************************************************************************} ******************************************************************************}
var var
strofpaths : string; strofpaths : string;
function getpathstring: string; function getpathstring: string;

5
rtl/amiga/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = True; LFNSupport = True;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;
AllFilesMask = '*'; AllFilesMask = '*';
@ -363,7 +366,7 @@ end;
begin begin
IsConsole := TRUE; IsConsole := TRUE;
IsLibrary := FALSE; IsLibrary := FALSE;
SysResetFPU; SysResetFPU;
if not(IsLibrary) then if not(IsLibrary) then
SysInitFPU; SysInitFPU;
StackLength := CheckInitialStkLen(InitialStkLen); StackLength := CheckInitialStkLen(InitialStkLen);

21
rtl/atari/system.pas
View File

@ -41,7 +41,10 @@ const
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *) CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 255; MaxPathLen = 255;
@ -284,13 +287,13 @@ end ['D0'];
Low Level File Routines Low Level File Routines
****************************************************************************} ****************************************************************************}
procedure AllowSlash(p:pchar); procedure DoDirSeparators(p:pchar);
var var
i : longint; i : longint;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=0 to strlen(p) do for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\'; if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
end; end;
@ -310,7 +313,7 @@ end;
procedure do_erase(p : pchar); procedure do_erase(p : pchar);
begin begin
AllowSlash(p); DoDirSeparators(p);
asm asm
move.l d2,d6 { save d2 } move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp) { save regs } movem.l d3/a2/a3,-(sp) { save regs }
@ -332,8 +335,8 @@ end;
procedure do_rename(p1,p2 : pchar); procedure do_rename(p1,p2 : pchar);
begin begin
AllowSlash(p1); DoDirSeparators(p1);
AllowSlash(p2); DoDirSeparators(p2);
asm asm
move.l d2,d6 { save d2 } move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp) movem.l d3/a2/a3,-(sp)
@ -502,7 +505,7 @@ var
i : word; i : word;
oflags: longint; oflags: longint;
begin begin
AllowSlash(p); DoDirSeparators(p);
{ close first if opened } { close first if opened }
if ((flags and $10000)=0) then if ((flags and $10000)=0) then
begin begin
@ -625,7 +628,7 @@ var
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer)); DoDirSeparators(pchar(@buffer));
c:=word(func); c:=word(func);
asm asm
move.l d2,d6 { save d2 } move.l d2,d6 { save d2 }
@ -702,8 +705,8 @@ begin
i:=0; i:=0;
while (temp[i]<>#0) do while (temp[i]<>#0) do
begin begin
if temp[i]='/' then if temp[i] in AllowDirectorySeparators then
temp[i]:='\'; temp[i]:=DirectorySeparator;
dir[i+3]:=temp[i]; dir[i+3]:=temp[i];
inc(i); inc(i);
end; end;

3
rtl/embedded/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ':'; PathSeparator = ':';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined below! } { FileNameCaseSensitive is defined below! }
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin

7
rtl/emx/dos.pas
View File

@ -180,8 +180,7 @@ begin
else else
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='/' then dirlist[i]:='\';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then
@ -195,8 +194,8 @@ begin
dirlist:=''; dirlist:='';
end; end;
if (newdir<>'') and if (newdir<>'') and
not (newdir[length(newdir)] in ['\',':']) then not (newdir[length(newdir)] in AllowDirectorySeparators+AllowDriveSeparators) then
newdir:=newdir+'\'; newdir:=newdir+DirectorySeparator;
if CheckFile (NewDir + Path + #0) then if CheckFile (NewDir + Path + #0) then
NewDir := NewDir + Path NewDir := NewDir + Path
else else

14
rtl/emx/sysdir.inc
View File

@ -27,7 +27,7 @@ var buffer:array[0..255] of char;
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); DoDirSeparators(Pchar(@buffer));
asm asm
leal buffer,%edx leal buffer,%edx
movb func,%ah movb func,%ah
@ -51,7 +51,7 @@ begin
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); DoDirSeparators(Pchar(@buffer));
Rc := DosCreateDir(buffer,nil); Rc := DosCreateDir(buffer,nil);
if Rc <> 0 then if Rc <> 0 then
begin begin
@ -81,7 +81,7 @@ begin
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); DoDirSeparators(Pchar(@buffer));
Rc := DosDeleteDir(buffer); Rc := DosDeleteDir(buffer);
if Rc <> 0 then if Rc <> 0 then
begin begin
@ -123,7 +123,7 @@ begin
begin begin
Move (S [1], Buffer, Length (S)); Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0; Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer)); DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer); RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then if RC <> 0 then
begin begin
@ -136,7 +136,7 @@ begin
begin begin
Move (S [1], Buffer, Length (S)); Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0; Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer)); DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer); RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then if RC <> 0 then
begin begin
@ -210,8 +210,8 @@ begin
while (dir[i]<>#0) do while (dir[i]<>#0) do
begin begin
{ convert path name to DOS } { convert path name to DOS }
if dir[i]='/' then if dir[i] in AllowDirectorySeparators then
dir[i]:='\'; dir[i]:=DirectorySeparator;
dir[0]:=char(i); dir[0]:=char(i);
inc(i); inc(i);
end; end;

18
rtl/emx/sysfile.inc
View File

@ -19,16 +19,6 @@
****************************************************************************} ****************************************************************************}
procedure allowslash(p:Pchar);
{Allow slash as backslash.}
var i:longint;
begin
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close (H: THandle); procedure do_close (H: THandle);
@ -53,7 +43,7 @@ end;
procedure do_erase(p:Pchar); procedure do_erase(p:Pchar);
begin begin
allowslash(p); DoDirSeparators(p);
asm asm
movl P,%edx movl P,%edx
movb $0x41,%ah movb $0x41,%ah
@ -67,8 +57,8 @@ end;
procedure do_rename(p1,p2:Pchar); procedure do_rename(p1,p2:Pchar);
begin begin
allowslash(p1); DoDirSeparators(p1);
allowslash(p2); DoDirSeparators(p2);
asm asm
movl P1, %edx movl P1, %edx
movl P2, %edi movl P2, %edi
@ -277,7 +267,7 @@ procedure do_open(var f;p:pchar;flags:longint);
var Action: cardinal; var Action: cardinal;
begin begin
allowslash(p); DoDirSeparators(p);
{ close first if opened } { close first if opened }
if ((flags and $10000)=0) then if ((flags and $10000)=0) then
begin begin

3
rtl/emx/system.pas
View File

@ -29,7 +29,10 @@ const
{ LFNSupport is defined separately below!!! } { LFNSupport is defined separately below!!! }
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;

3
rtl/gba/system.pp
View File

@ -35,7 +35,10 @@ const
CtrlZMarksEOF: boolean = false; CtrlZMarksEOF: boolean = false;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 255; MaxPathLen = 255;

14
rtl/go32v2/dos.pp
View File

@ -217,9 +217,7 @@ begin
{ create path } { create path }
p:=path; p:=path;
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(p) do DoDirSeparators(p);
if p[i]='/' then
p[i]:='\';
if LFNSupport then if LFNSupport then
GetShortName(p); GetShortName(p);
{ create buffer } { create buffer }
@ -232,7 +230,6 @@ begin
paste_to_dos(envstr(i),false,1); paste_to_dos(envstr(i),false,1);
{the behaviour is still suboptimal because variable COMMAND is stripped out} {the behaviour is still suboptimal because variable COMMAND is stripped out}
paste_to_dos(chr(0),false,1); { adds a double zero at the end } paste_to_dos(chr(0),false,1); { adds a double zero at the end }
{ allow slash as backslash }
la_p:=current_dos_buffer_pos; la_p:=current_dos_buffer_pos;
paste_to_dos(p,false,0); paste_to_dos(p,false,0);
la_c:=current_dos_buffer_pos; la_c:=current_dos_buffer_pos;
@ -472,8 +469,7 @@ var
w : LFNSearchRec; w : LFNSearchRec;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=0 to strlen(path) do DoDirSeparators(path);
if path[i]='/' then path[i]:='\';
dosregs.si:=1; { use ms-dos time } dosregs.si:=1; { use ms-dos time }
{ don't include the label if not asked for it, needed for network drives } { don't include the label if not asked for it, needed for network drives }
if attr=$8 then if attr=$8 then
@ -571,8 +567,7 @@ var
i : longint; i : longint;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=0 to strlen(path) do DoDirSeparators(path);
if path[i]='/' then path[i]:='\';
copytodos(f,sizeof(searchrec)); copytodos(f,sizeof(searchrec));
dosregs.edx:=tb_offset; dosregs.edx:=tb_offset;
dosregs.ds:=tb_segment; dosregs.ds:=tb_segment;
@ -683,8 +678,7 @@ begin
else else
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='/' then dirlist[i]:='\';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then

2
rtl/go32v2/emu387.pp
View File

@ -187,7 +187,7 @@ begin
if length(cp)=0 then if length(cp)=0 then
begin begin
for i:=length(prog_name) downto 1 do for i:=length(prog_name) downto 1 do
if (prog_name[i]='\') or (prog_name[i]='/') then if prog_name[i] in AllowDirectorySeparators then
break; break;
if i>1 then if i>1 then
cp:=copy(prog_name,1,i); cp:=copy(prog_name,1,i);

6
rtl/go32v2/sysdir.inc
View File

@ -25,7 +25,7 @@ var
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer)); DoDirSeparators(pchar(@buffer));
{ True DOS does not like backslashes at end { True DOS does not like backslashes at end
Win95 DOS accepts this !! Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM } but "\" and "c:\" should still be kept and accepted hopefully PM }
@ -118,8 +118,8 @@ begin
i:=0; i:=0;
while (temp[i]<>#0) do while (temp[i]<>#0) do
begin begin
if temp[i]='/' then if temp[i] in AllowDirectorySeparators then
temp[i]:='\'; temp[i]:=DirectorySeparator;
dir[i+4]:=temp[i]; dir[i+4]:=temp[i];
inc(i); inc(i);
end; end;

17
rtl/go32v2/sysfile.inc
View File

@ -29,15 +29,6 @@
Low level File Routines Low level File Routines
****************************************************************************} ****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(handle : thandle); procedure do_close(handle : thandle);
var var
regs : trealregs; regs : trealregs;
@ -67,7 +58,7 @@ procedure do_erase(p : pchar);
var var
regs : trealregs; regs : trealregs;
begin begin
AllowSlash(p); DoDirSeparators(p);
syscopytodos(longint(p),strlen(p)+1); syscopytodos(longint(p),strlen(p)+1);
regs.realedx:=tb_offset; regs.realedx:=tb_offset;
regs.realds:=tb_segment; regs.realds:=tb_segment;
@ -87,8 +78,8 @@ procedure do_rename(p1,p2 : pchar);
var var
regs : trealregs; regs : trealregs;
begin begin
AllowSlash(p1); DoDirSeparators(p1);
AllowSlash(p2); DoDirSeparators(p2);
if strlen(p1)+strlen(p2)+3>tb_size then if strlen(p1)+strlen(p2)+3>tb_size then
HandleError(217); HandleError(217);
sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1); sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
@ -301,7 +292,7 @@ var
regs : trealregs; regs : trealregs;
action : longint; action : longint;
begin begin
AllowSlash(p); DoDirSeparators(p);
{ close first if opened } { close first if opened }
if ((flags and $10000)=0) then if ((flags and $10000)=0) then
begin begin

3
rtl/go32v2/system.pp
View File

@ -39,7 +39,10 @@ const
{ LFNSupport is a variable here, defined below!!! } { LFNSupport is a variable here, defined below!!! }
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;

29
rtl/inc/dos.inc
View File

@ -16,9 +16,14 @@
**********************************************************************} **********************************************************************}
(* Everywhere the same now, but prepared for potential difference. *) procedure DoDirSeparators(var p:shortstring);
const var
ExtensionSeparator = '.'; i : longint;
begin
for i:=1 to length(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
{$IFNDEF HAS_DOSEXITCODE} {$IFNDEF HAS_DOSEXITCODE}
threadvar threadvar
@ -219,18 +224,8 @@ Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: Ex
var var
DirEnd, ExtStart: Longint; DirEnd, ExtStart: Longint;
begin begin
if DirectorySeparator = '/' then { allow slash and backslash }
{ allow backslash as slash } DoDirSeparators(Path);
for DirEnd := 1 to Length (Path) do
begin
if Path [DirEnd] = '\' then Path [DirEnd] := DirectorySeparator
end
else
if DirectorySeparator = '\' then
{ allow slash as backslash }
for DirEnd := 1 to Length (Path) do
if Path [DirEnd] = '/' then Path [DirEnd] := DirectorySeparator;
{ Find the first DirectorySeparator or DriveSeparator from the end. } { Find the first DirectorySeparator or DriveSeparator from the end. }
DirEnd := Length (Path); DirEnd := Length (Path);
{ Avoid problems with platforms having DriveSeparator = DirectorySeparator. } { Avoid problems with platforms having DriveSeparator = DirectorySeparator. }
@ -239,8 +234,8 @@ begin
Dec (DirEnd) Dec (DirEnd)
else else
while (DirEnd > 0) and while (DirEnd > 0) and
(Path [DirEnd] <> DirectorySeparator) and (Path [DirEnd] <> DirectorySeparator) and
(Path [DirEnd] <> DriveSeparator) do (Path [DirEnd] <> DriveSeparator) do
Dec (DirEnd); Dec (DirEnd);
{ The first "extension" should be returned if LFN } { The first "extension" should be returned if LFN }

2
rtl/inc/exeinfo.pp
View File

@ -1069,7 +1069,7 @@ begin
end; end;
{ executable dir } { executable dir }
i:=length(e.filename); i:=length(e.filename);
while (i>0) and not(e.filename[i] in ['/','\']) do while (i>0) and not(e.filename[i] in AllowDirectorySeparators) do
dec(i); dec(i);
if i>0 then if i>0 then
begin begin

18
rtl/inc/fexpand.inc
View File

@ -127,21 +127,9 @@ begin
(* Allow both '/' and '\' as directory separators *) (* Allow both '/' and '\' as directory separators *)
(* by converting all to the native one. *) (* by converting all to the native one. *)
{$warnings off} {$warnings off}
if DirectorySeparator = '\' then for I := 1 to Length (Pa) do
{Allow slash as backslash} if Pa [I] in AllowDirectorySeparators then
begin Pa [I] := DirectorySeparator;
for I := 1 to Length (Pa) do
if Pa [I] = '/' then
Pa [I] := '\'
end
else
if DirectorySeparator = '/' then
{Allow backslash as slash}
begin
for I := 1 to Length (Pa) do
if Pa [I] = '\' then
Pa [I] := '/';
end;
{$warnings on} {$warnings on}
(* PathStart is amount of characters to strip to get beginning *) (* PathStart is amount of characters to strip to get beginning *)

21
rtl/inc/system.inc
View File

@ -92,7 +92,7 @@ function do_isdevice(handle:thandle):boolean;forward;
****************************************************************************} ****************************************************************************}
{$ifdef FPC_USE_LIBC} {$ifdef FPC_USE_LIBC}
{ Under Haiku, bcopy cause a problem when searching for include file { Under Haiku, bcopy cause a problem when searching for include file
in the compiler. So, we use the internal implementation for now in the compiler. So, we use the internal implementation for now
under BeOS and Haiku. } under BeOS and Haiku. }
{$ifndef BEOS} {$ifndef BEOS}
@ -1247,6 +1247,25 @@ end;
File Handling File Handling
*****************************************************************************} *****************************************************************************}
{ Allow slash and backslash as separators }
procedure DoDirSeparators(p:Pchar);
var
i : longint;
begin
for i:=0 to strlen(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
procedure DoDirSeparators(var p:shortstring);
var
i : longint;
begin
for i:=1 to length(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
{ OS dependent low level file functions } { OS dependent low level file functions }
{$ifdef FPC_HAS_FEATURE_FILEIO} {$ifdef FPC_HAS_FEATURE_FILEIO}
{$i sysfile.inc} {$i sysfile.inc}

6
rtl/macos/macutils.inc
View File

@ -213,7 +213,7 @@ end;
if path[oldPos] = '.' then if path[oldPos] = '.' then
if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then
begin begin
if (oldpos + 2 > oldlen) or (path[oldPos + 2] in ['/', '\']) then if (oldpos + 2 > oldlen) or (path[oldPos + 2] in AllowDirectorySeparators) then
begin begin
{It is "../" or ".." translates to ":" } {It is "../" or ".." translates to ":" }
if newPos = maxPos then if newPos = maxPos then
@ -226,7 +226,7 @@ end;
continue; {Start over again} continue; {Start over again}
end; end;
end end
else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in ['/', '\']) then else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in AllowDirectorySeparators) then
begin begin
{It is "./" or "." ignor it } {It is "./" or "." ignor it }
oldPos := oldPos + 2; oldPos := oldPos + 2;
@ -234,7 +234,7 @@ end;
end; end;
{Collect file or dir name} {Collect file or dir name}
while (oldpos <= oldlen) and not (path[oldPos] in ['/', '\']) do while (oldpos <= oldlen) and not (path[oldPos] in AllowDirectorySeparators) do
begin begin
if newPos = maxPos then if newPos = maxPos then
begin {Shouldn't actually happen, but..} begin {Shouldn't actually happen, but..}

7
rtl/macos/system.pp
View File

@ -24,14 +24,17 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = ':'; DirectorySeparator = ':';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ','; {Is used in MPW and OzTeX} PathSeparator = ','; {Is used in MPW and OzTeX}
AllowDirectorySeparators : set of char = [':'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *) CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
maxExitCode = 65535; maxExitCode = 65535;
MaxPathLen = 256; MaxPathLen = 256;
AllFilesMask = '*'; AllFilesMask = '*';
const const
{ Default filehandles } { Default filehandles }
UnusedHandle : Longint = -1; UnusedHandle : Longint = -1;

19
rtl/morphos/dos.pp
View File

@ -122,8 +122,8 @@ procedure Amiga2DateStamp(Date : LongInt; var TotalDays,Minutes,Ticks: longint);
{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format } { Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
{ Taken from SWAG and modified to work with the Amiga format - CEC } { Taken from SWAG and modified to work with the Amiga format - CEC }
var var
LocalDate : LongInt; LocalDate : LongInt;
Done : Boolean; Done : Boolean;
TotDays : Integer; TotDays : Integer;
Y: Word; Y: Word;
H: Word; H: Word;
@ -183,7 +183,7 @@ begin
end; end;
function dosSetFileDate(name: string; p : PDateStamp): Boolean; function dosSetFileDate(name: string; p : PDateStamp): Boolean;
var var
buffer : array[0..255] of Char; buffer : array[0..255] of Char;
begin begin
move(name[1],buffer,length(name)); move(name[1],buffer,length(name));
@ -448,7 +448,7 @@ begin
DosError:= 0; DosError:= 0;
LastDosExitCode:=0; LastDosExitCode:=0;
tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :) tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :)
{ Here we must first check if the command we wish to execute } { Here we must first check if the command we wish to execute }
{ actually exists, because this is NOT handled by the } { actually exists, because this is NOT handled by the }
{ _SystemTagList call (program will abort!!) } { _SystemTagList call (program will abort!!) }
@ -727,8 +727,7 @@ begin
DosError:=0; DosError:=0;
FTime := 0; FTime := 0;
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(str);
if str[i]='\' then str[i]:='/';
FLock := dosLock(Str, SHARED_LOCK); FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then begin IF FLock <> 0 then begin
New(FInfo); New(FInfo);
@ -759,8 +758,7 @@ end;
Begin Begin
new(DateStamp); new(DateStamp);
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(str);
if str[i]='\' then str[i]:='/';
{ Check first of all, if file exists } { Check first of all, if file exists }
FLock := dosLock(Str, SHARED_LOCK); FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then IF FLock <> 0 then
@ -792,8 +790,7 @@ begin
flags:=0; flags:=0;
New(info); New(info);
Str := StrPas(filerec(f).name); Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do DoDirSeparators(str);
if str[i]='\' then str[i]:='/';
{ open with shared lock to check if file exists } { open with shared lock to check if file exists }
MyLock:=dosLock(Str,SHARED_LOCK); MyLock:=dosLock(Str,SHARED_LOCK);
if MyLock <> 0 then if MyLock <> 0 then
@ -854,7 +851,7 @@ end;
--- Environment --- --- Environment ---
******************************************************************************} ******************************************************************************}
var var
strofpaths : string; strofpaths : string;
function getpathstring: string; function getpathstring: string;

23
rtl/morphos/system.pp
View File

@ -32,11 +32,14 @@ const
LFNSupport = True; LFNSupport = True;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;
AllFilesMask = '*'; AllFilesMask = '*';
const const
UnusedHandle : LongInt = -1; UnusedHandle : LongInt = -1;
StdInputHandle : LongInt = 0; StdInputHandle : LongInt = 0;
@ -266,7 +269,7 @@ begin
while tmpbuf[counter]<>#0 do counter+=1; while tmpbuf[counter]<>#0 do counter+=1;
tmpbuf[0]:=Char(counter-1); tmpbuf[0]:=Char(counter-1);
GetArgv0Ambient:=tmpbuf; GetArgv0Ambient:=tmpbuf;
{ Append slash,if we're not in root directory of a volume } { Append slash,if we're not in root directory of a volume }
if tmpbuf[counter-1]<>':' then GetArgv0Ambient+='/'; if tmpbuf[counter-1]<>':' then GetArgv0Ambient+='/';
end; end;
end; end;
@ -276,9 +279,9 @@ begin
if progname<>nil then begin if progname<>nil then begin
FillDWord(tmpbuf,256 div 4,0); FillDWord(tmpbuf,256 div 4,0);
counter:=0; counter:=0;
while (progname[counter]<>#0) do begin while (progname[counter]<>#0) do begin
tmpbuf[counter+1]:=progname[counter]; tmpbuf[counter+1]:=progname[counter];
counter+=1; counter+=1;
end; end;
tmpbuf[0]:=Char(counter); tmpbuf[0]:=Char(counter);
GetArgv0Ambient+=tmpbuf; GetArgv0Ambient+=tmpbuf;
@ -309,11 +312,11 @@ var
begin begin
paramstr:=''; paramstr:='';
if MOS_ambMsg<>nil then begin if MOS_ambMsg<>nil then begin
if l=0 then begin if l=0 then begin
paramstr:=GetArgv0Ambient; paramstr:=GetArgv0Ambient;
exit; exit;
end else end else
exit; exit;
end; end;
if l=0 then begin if l=0 then begin

25
rtl/nds/system.pp
View File

@ -26,7 +26,7 @@ interface
{$i softfpu.pp} {$i softfpu.pp}
{$undef fpc_softfpu_interface} {$undef fpc_softfpu_interface}
function IsARM9(): boolean; function IsARM9(): boolean;
const const
LineEnding = #10; LineEnding = #10;
@ -34,7 +34,10 @@ const
CtrlZMarksEOF: boolean = false; CtrlZMarksEOF: boolean = false;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 255; MaxPathLen = 255;
@ -54,7 +57,7 @@ var
argv: PPChar; argv: PPChar;
envp: PPChar; envp: PPChar;
errno: integer; errno: integer;
fake_heap_end: ^byte; cvar; fake_heap_end: ^byte; cvar;
implementation implementation
@ -78,19 +81,19 @@ implementation
{$i ndsbios.inc} {$i ndsbios.inc}
{ {
NDS CPU detecting function (thanks to 21o6): NDS CPU detecting function (thanks to 21o6):
-------------------------------------------- --------------------------------------------
"You see, the ARM7 can't write to bank A of VRAM, but it doesn't give any "You see, the ARM7 can't write to bank A of VRAM, but it doesn't give any
error ... it just doesn't write there... so it's easily determinable what error ... it just doesn't write there... so it's easily determinable what
CPU is running the code" CPU is running the code"
ARM946E-S processor can handle dsp extensions extensions, but ARM7TDMI does ARM946E-S processor can handle dsp extensions extensions, but ARM7TDMI does
not. FPC can't retrieve the CPU target at compiling time, so this small not. FPC can't retrieve the CPU target at compiling time, so this small
function takes care to check if the code is running on an ARM9 or on an ARM7 function takes care to check if the code is running on an ARM9 or on an ARM7
CPU. It works on Nintendo DS only, I guess :) CPU. It works on Nintendo DS only, I guess :)
} }
function IsARM9(): boolean; function IsARM9(): boolean;
var var
Dummy : pword absolute $06800000; Dummy : pword absolute $06800000;
tmp: word; tmp: word;
@ -163,9 +166,9 @@ begin
{ OS specific startup } { OS specific startup }
{ Set up signals handlers } { Set up signals handlers }
if IsARM9 then if IsARM9 then
fpc_cpucodeinit; fpc_cpucodeinit;
{ Setup heap } { Setup heap }
InitHeap; InitHeap;
SysInitExceptions; SysInitExceptions;

9
rtl/netware/dos.pp
View File

@ -371,8 +371,7 @@ begin
else else
begin begin
{ allow backslash as slash } { allow backslash as slash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='\' then dirlist[i]:='/';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then
@ -486,11 +485,7 @@ begin
end; end;
for i := 1 to length(GetEnv) do DoDirSeparators(getenv);
if GetEnv[i] = '\' then
GetEnv[i] := '/';
end else end else
begin begin

3
rtl/netware/sysdir.inc
View File

@ -70,8 +70,7 @@ begin
begin begin
Move (P, dir[1], i); Move (P, dir[1], i);
BYTE(dir[0]) := i; BYTE(dir[0]) := i;
For i := 1 to length (dir) do DoDirSeparators(dir);
if dir[i] = '\' then dir [i] := '/';
// fix / after volume, the compiler needs that // fix / after volume, the compiler needs that
// normaly root of a volumes is SERVERNAME/SYS:, change that // normaly root of a volumes is SERVERNAME/SYS:, change that
// to SERVERNAME/SYS:/ // to SERVERNAME/SYS:/

6
rtl/netware/system.pp
View File

@ -39,7 +39,10 @@ const
LFNSupport : boolean = false; LFNSupport : boolean = false;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;
@ -216,8 +219,7 @@ begin
paramstr:=strpas(argv[l]); paramstr:=strpas(argv[l]);
if l = 0 then // fix nlm path if l = 0 then // fix nlm path
begin begin
for l := 1 to length (paramstr) do DoDirSeparators(paramstr);
if paramstr[l] = '\' then paramstr[l] := '/';
end; end;
end else end else
paramstr:=''; paramstr:='';

9
rtl/netwlibc/dos.pp
View File

@ -380,7 +380,7 @@ begin
end; end;
f._attr := attr; f._attr := attr;
p := length (path); p := length (path);
while (p > 0) and (not (path[p] in ['\','/'])) do while (p > 0) and (not (path[p] in AllowDirectorySeparators)) do
dec (p); dec (p);
if p > 0 then if p > 0 then
begin begin
@ -472,8 +472,7 @@ begin
else else
begin begin
{ allow backslash as slash } { allow backslash as slash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='\' then dirlist[i]:='/';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then
@ -659,9 +658,7 @@ begin
inc (i); inc (i);
res := GetSearchPathElement (i, isdosPath, @SearchElement[0]); res := GetSearchPathElement (i, isdosPath, @SearchElement[0]);
end; end;
for i := 1 to length(GetEnv) do DoDirSeparators(getenv);
if GetEnv[i] = '\' then
GetEnv[i] := '/';
end else end else
begin begin
strpcopy(envvar0,envvar); strpcopy(envvar0,envvar);

3
rtl/netwlibc/sysdir.inc
View File

@ -70,8 +70,7 @@ begin
begin begin
Move (P, dir[1], i); Move (P, dir[1], i);
BYTE(dir[0]) := i; BYTE(dir[0]) := i;
For i := 1 to length (dir) do DoDirSeparators(dir);
if dir[i] = '\' then dir [i] := '/';
// fix / after volume, the compiler needs that // fix / after volume, the compiler needs that
// normaly root of a volumes is SERVERNAME/SYS:, change that // normaly root of a volumes is SERVERNAME/SYS:, change that
// to SERVERNAME/SYS:/ // to SERVERNAME/SYS:/

6
rtl/netwlibc/system.pp
View File

@ -45,7 +45,10 @@ const
LFNSupport : boolean = false; LFNSupport : boolean = false;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = $ffff; maxExitCode = $ffff;
MaxPathLen = 256; MaxPathLen = 256;
@ -200,8 +203,7 @@ begin
paramstr:=strpas(argv[l]); paramstr:=strpas(argv[l]);
if l = 0 then // fix nlm path if l = 0 then // fix nlm path
begin begin
for l := 1 to length (paramstr) do DoDirSeparators(paramstr);
if paramstr[l] = '\' then paramstr[l] := '/';
end; end;
end else end else
paramstr:=''; paramstr:='';

2
rtl/netwlibc/sysutils.pp
View File

@ -258,7 +258,7 @@ begin
end; end;
Rslt.FindData._attr := attr; Rslt.FindData._attr := attr;
p := length (path); p := length (path);
while (p > 0) and (not (path[p] in ['\','/'])) do while (p > 0) and (not (path[p] in AllowDirectorySeparators)) do
dec (p); dec (p);
if p > 0 then if p > 0 then
begin begin

47
rtl/objpas/sysutils/fina.inc
View File

@ -26,7 +26,7 @@ var
EndSep : Set of Char; EndSep : Set of Char;
begin begin
i := Length(FileName); i := Length(FileName);
EndSep:=DirSeparators+[':','.']; EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not(FileName[I] in EndSep) do while (I > 0) and not(FileName[I] in EndSep) do
Dec(I); Dec(I);
if (I = 0) or (FileName[I] <> '.') then if (I = 0) or (FileName[I] <> '.') then
@ -40,7 +40,7 @@ var
EndSep : Set of Char; EndSep : Set of Char;
begin begin
i := Length(FileName); i := Length(FileName);
EndSep:=DirSeparators+[':']; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (i > 0) and not (FileName[i] in EndSep) do while (i > 0) and not (FileName[i] in EndSep) do
Dec(i); Dec(i);
If I>0 then If I>0 then
@ -55,10 +55,10 @@ var
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=DirSeparators+[':']; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not (FileName[I] in EndSep) do
Dec(I); Dec(I);
if (I > 1) and (FileName[I] in DirSeparators) and if (I > 1) and (FileName[I] in AllowDirectorySeparators) and
not (FileName[I - 1] in EndSep) then not (FileName[I - 1] in EndSep) then
Dec(I); Dec(I);
Result := Copy(FileName, 1, I); Result := Copy(FileName, 1, I);
@ -74,13 +74,13 @@ begin
l:=Length(FileName); l:=Length(FileName);
if (L<2) then if (L<2) then
exit; exit;
If (FileName[2]=':') then If (FileName[2] in AllowDriveSeparators) then
result:=Copy(FileName,1,2) result:=Copy(FileName,1,2)
else if (FileName[1] in DirSeparators) and else if (FileName[1] in AllowDirectorySeparators) and
(FileName[2] in DirSeparators) then (FileName[2] in AllowDirectorySeparators) then
begin begin
i := 2; i := 2;
While (i<L) and Not (Filename[i+1] in DirSeparators) do While (i<L) and Not (Filename[i+1] in AllowDirectorySeparators) do
inc(i); inc(i);
Result:=Copy(FileName,1,i); Result:=Copy(FileName,1,i);
end; end;
@ -92,7 +92,7 @@ var
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=DirSeparators+[':']; EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not (FileName[I] in EndSep) do
Dec(I); Dec(I);
Result := Copy(FileName, I + 1, MaxInt); Result := Copy(FileName, I + 1, MaxInt);
@ -104,7 +104,7 @@ var
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=DirSeparators+['.', ':']; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not (FileName[I] in EndSep) do
Dec(I); Dec(I);
if (I > 0) and (FileName[I] = '.') then if (I > 0) and (FileName[I] = '.') then
@ -116,7 +116,7 @@ end;
function ExtractShortPathName(Const FileName : String) : String; function ExtractShortPathName(Const FileName : String) : String;
begin begin
{$ifdef MSWINDOWS} {$ifdef MSWINDOWS}
SetLength(Result,Max_Path); SetLength(Result,Max_Path);
SetLength(Result,GetShortPathName(PChar(FileName), Pchar(Result),Length(Result))); SetLength(Result,GetShortPathName(PChar(FileName), Pchar(Result),Length(Result)));
{$else} {$else}
@ -161,7 +161,7 @@ Var Source, Dest : String;
Sc,Dc,I,J : Longint; Sc,Dc,I,J : Longint;
SD,DD : Array[1..MaxDirs] of PChar; SD,DD : Array[1..MaxDirs] of PChar;
Const OneLevelBack = '..'+PathDelim; Const OneLevelBack = '..'+DirectorySeparator;
begin begin
If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
@ -183,7 +183,7 @@ begin
end; end;
Result:=''; Result:='';
For J:=I to SC do Result:=Result+OneLevelBack; For J:=I to SC do Result:=Result+OneLevelBack;
For J:=I to DC do Result:=Result+DD[J]+PathDelim; For J:=I to DC do Result:=Result+DD[J]+DirectorySeparator;
Result:=Result+ExtractFileName(DestNAme); Result:=Result+ExtractFileName(DestNAme);
end; end;
@ -193,8 +193,8 @@ VAr I : longint;
begin begin
For I:=1 to Length(FileName) do For I:=1 to Length(FileName) do
If FileName[I] in DirSeparators then If FileName[I] in AllowDirectorySeparators then
FileName[i]:=PathDelim; FileName[i]:=DirectorySeparator;
end; end;
@ -210,7 +210,6 @@ end;
Dirs is an array of pchars, pointing to these directory names. Dirs is an array of pchars, pointing to these directory names.
The function returns the number of directories found, or -1 The function returns the number of directories found, or -1
if none were found. if none were found.
DirName must contain only PathDelim as Directory separator chars.
} }
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint; Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
@ -222,13 +221,13 @@ begin
Result:=-1; Result:=-1;
While I<=Length(DirName) do While I<=Length(DirName) do
begin begin
If (DirName[i]=PathDelim) and If (DirName[i] in AllowDirectorySeparators) and
{ avoid error in case last char=pathdelim } { avoid error in case last char=pathdelim }
(length(dirname)>i) then (length(dirname)>i) then
begin begin
DirName[i]:=#0; DirName[i]:=#0;
Inc(Result); Inc(Result);
Dirs[Result]:=@DirName[I+1]; Dirs[Result]:=@DirName[I+1];
end; end;
Inc(I); Inc(I);
end; end;
@ -243,8 +242,8 @@ Var
begin begin
Result:=Path; Result:=Path;
l:=Length(Result); l:=Length(Result);
If (L=0) or not(Result[l] in DirSeparators) then If (L=0) or not(Result[l] in AllowDirectorySeparators) then
Result:=Result+PathDelim; Result:=Result+DirectorySeparator;
end; end;
function IncludeTrailingBackslash(Const Path : String) : String; function IncludeTrailingBackslash(Const Path : String) : String;
@ -266,7 +265,7 @@ Var
begin begin
L:=Length(Path); L:=Length(Path);
If (L>0) and (Path[L] in DirSeparators) then If (L>0) and (Path[L] in AllowDirectorySeparators) then
Dec(L); Dec(L);
Result:=Copy(Path,1,L); Result:=Copy(Path,1,L);
end; end;
@ -274,7 +273,7 @@ end;
function IsPathDelimiter(Const Path: string; Index: Integer): Boolean; function IsPathDelimiter(Const Path: string; Index: Integer): Boolean;
begin begin
Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in DirSeparators); Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in AllowDirectorySeparators);
end; end;
Function GetFileHandle(var f : File):Longint; Function GetFileHandle(var f : File):Longint;

4
rtl/objpas/sysutils/finah.inc
View File

@ -20,10 +20,6 @@
System Utilities For Free Pascal System Utilities For Free Pascal
} }
Const
DirSeparators : set of char = ['/','\'];
function ChangeFileExt(const FileName, Extension: string): string; function ChangeFileExt(const FileName, Extension: string): string;
function ExtractFilePath(const FileName: string): string; function ExtractFilePath(const FileName: string): string;
function ExtractFileDrive(const FileName: string): string; function ExtractFileDrive(const FileName: string): string;

12
rtl/os2/sysdir.inc
View File

@ -27,7 +27,7 @@ begin
exit; exit;
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); DoDirSeparators(Pchar(@buffer));
Rc := DosCreateDir(buffer,nil); Rc := DosCreateDir(buffer,nil);
if Rc <> 0 then if Rc <> 0 then
begin begin
@ -47,7 +47,7 @@ begin
exit; exit;
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); DoDirSeparators(Pchar(@buffer));
Rc := DosDeleteDir(buffer); Rc := DosDeleteDir(buffer);
if Rc <> 0 then if Rc <> 0 then
begin begin
@ -75,7 +75,7 @@ begin
begin begin
Move (S [1], Buffer, Length (S)); Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0; Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer)); DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer); RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then if RC <> 0 then
begin begin
@ -86,7 +86,7 @@ begin
end else begin end else begin
Move (S [1], Buffer, Length (S)); Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0; Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer)); DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer); RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then if RC <> 0 then
begin begin
@ -124,8 +124,8 @@ begin
while (dir[i]<>#0) do while (dir[i]<>#0) do
begin begin
{ convert path name to DOS } { convert path name to DOS }
if dir[i]='/' then if dir[i] in AllowDirectorySeparators then
dir[i]:='\'; dir[i]:=DirectorySeparator;
dir[0]:=char(i); dir[0]:=char(i);
inc(i); inc(i);
end; end;

16
rtl/os2/sysfile.inc
View File

@ -19,14 +19,6 @@
****************************************************************************} ****************************************************************************}
procedure allowslash(p:Pchar);
{Allow slash as backslash.}
var i:longint;
begin
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(h:thandle); procedure do_close(h:thandle);
begin begin
{ Only three standard handles under real OS/2 } { Only three standard handles under real OS/2 }
@ -41,14 +33,14 @@ end;
procedure do_erase(p:Pchar); procedure do_erase(p:Pchar);
begin begin
allowslash(p); DoDirSeparators(p);
inoutres:=DosDelete(p); inoutres:=DosDelete(p);
end; end;
procedure do_rename(p1,p2:Pchar); procedure do_rename(p1,p2:Pchar);
begin begin
allowslash(p1); DoDirSeparators(p1);
allowslash(p2); DoDirSeparators(p2);
inoutres:=DosMove(p1, p2); inoutres:=DosMove(p1, p2);
end; end;
@ -162,7 +154,7 @@ var
Action, Attrib, OpenFlags, FM: Cardinal; Action, Attrib, OpenFlags, FM: Cardinal;
begin begin
// convert unix slashes to normal slashes // convert unix slashes to normal slashes
allowslash(p); DoDirSeparators(p);
// close first if opened // close first if opened
if ((flags and $10000)=0) then if ((flags and $10000)=0) then

7
rtl/os2/system.pas
View File

@ -37,12 +37,15 @@ const
{ LFNSupport is defined separately below!!! } { LFNSupport is defined separately below!!! }
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
MaxExitCode = 65535; MaxExitCode = 65535;
MaxPathLen = 256; MaxPathLen = 256;
AllFilesMask = '*'; AllFilesMask = '*';
type Tos=(osDOS,osOS2,osDPMI); type Tos=(osDOS,osOS2,osDPMI);
const OS_Mode: Tos = osOS2; const OS_Mode: Tos = osOS2;
@ -93,7 +96,7 @@ procedure WriteUseHighMem (B: boolean);
(* underlying OS/2 version, can be overridden by user - heap is allocated *) (* underlying OS/2 version, can be overridden by user - heap is allocated *)
(* for all threads, so the setting isn't declared as a threadvar and *) (* for all threads, so the setting isn't declared as a threadvar and *)
(* should be only changed at the beginning of the main thread if needed. *) (* should be only changed at the beginning of the main thread if needed. *)
property property
UseHighMem: boolean read ReadUseHighMem write WriteUseHighMem; UseHighMem: boolean read ReadUseHighMem write WriteUseHighMem;
(* UseHighMem is provided for compatibility with 2.0.x. *) (* UseHighMem is provided for compatibility with 2.0.x. *)

3
rtl/palmos/system.pp
View File

@ -27,7 +27,10 @@ const
LFNSupport = false; LFNSupport = false;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false; FileNameCaseSensitive = false;
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *) CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
maxExitCode = 255; {$ERROR TODO: CONFIRM THIS} maxExitCode = 255; {$ERROR TODO: CONFIRM THIS}

5
rtl/symbian/system.pp
View File

@ -32,7 +32,10 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below } { FileNameCaseSensitive is defined separately below }
maxExitCode = 65535; maxExitCode = 65535;
MaxPathLen = 260; MaxPathLen = 260;
@ -185,7 +188,7 @@ begin
{ if we pass here there was no error } { if we pass here there was no error }
system_exit; system_exit;
Result := KErrNone; Result := KErrNone;
end; end;

7
rtl/unix/sysunixh.inc
View File

@ -28,8 +28,11 @@ const
LineEnding = #10; LineEnding = #10;
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = ':'; DriveSeparator = '/';
ExtensionSeparator = '.';
PathSeparator = ':'; PathSeparator = ':';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [];
{ FileNameCaseSensitive is defined below! } { FileNameCaseSensitive is defined below! }
maxExitCode = 255; maxExitCode = 255;
{$ifdef LINUX} {$ifdef LINUX}
@ -38,7 +41,7 @@ const
MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin
{$endif} {$endif}
AllFilesMask = '*'; AllFilesMask = '*';
const const
UnusedHandle = -1; UnusedHandle = -1;
StdInputHandle = 0; StdInputHandle = 0;

13
rtl/watcom/dos.pp
View File

@ -204,9 +204,7 @@ begin
c[0]:=char(length(comline)+2); c[0]:=char(length(comline)+2);
{ create path } { create path }
p:=path; p:=path;
for i:=1 to length(p) do DoDirSeparators(p);
if p[i]='/' then
p[i]:='\';
if LFNSupport then if LFNSupport then
GetShortName(p); GetShortName(p);
{ create buffer } { create buffer }
@ -460,8 +458,7 @@ var
w : LFNSearchRec; w : LFNSearchRec;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=0 to strlen(path) do DoDirSeparators(path);
if path[i]='/' then path[i]:='\';
dosregs.si:=1; { use ms-dos time } dosregs.si:=1; { use ms-dos time }
{ don't include the label if not asked for it, needed for network drives } { don't include the label if not asked for it, needed for network drives }
if attr=$8 then if attr=$8 then
@ -540,8 +537,7 @@ var
i : longint; i : longint;
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=0 to strlen(path) do DoDirSeparators(path);
if path[i]='/' then path[i]:='\';
copytodos(f,sizeof(searchrec)); copytodos(f,sizeof(searchrec));
dosregs.edx:=tb_offset; dosregs.edx:=tb_offset;
dosregs.ds:=tb_segment; dosregs.ds:=tb_segment;
@ -653,8 +649,7 @@ begin
else else
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='/' then dirlist[i]:='\';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then

6
rtl/watcom/sysdir.inc
View File

@ -9,7 +9,7 @@ var
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer)); DoDirSeparators(pchar(@buffer));
{ True DOS does not like backslashes at end { True DOS does not like backslashes at end
Win95 DOS accepts this !! Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM } but "\" and "c:\" should still be kept and accepted hopefully PM }
@ -102,8 +102,8 @@ begin
i:=0; i:=0;
while (temp[i]<>#0) do while (temp[i]<>#0) do
begin begin
if temp[i]='/' then if temp[i] in AllowDirectorySeparators then
temp[i]:='\'; temp[i]:=DirectorySeparator;
dir[i+4]:=temp[i]; dir[i+4]:=temp[i];
inc(i); inc(i);
end; end;

17
rtl/watcom/sysfile.inc
View File

@ -13,15 +13,6 @@
Low level File Routines Low level File Routines
****************************************************************************} ****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(handle : longint); procedure do_close(handle : longint);
var var
regs : trealregs; regs : trealregs;
@ -50,7 +41,7 @@ procedure do_erase(p : pchar);
var var
regs : trealregs; regs : trealregs;
begin begin
AllowSlash(p); DoDirSeparators(p);
syscopytodos(longint(p),strlen(p)+1); syscopytodos(longint(p),strlen(p)+1);
regs.realedx:=tb_offset; regs.realedx:=tb_offset;
regs.realds:=tb_segment; regs.realds:=tb_segment;
@ -69,8 +60,8 @@ procedure do_rename(p1,p2 : pchar);
var var
regs : trealregs; regs : trealregs;
begin begin
AllowSlash(p1); DoDirSeparators(p1);
AllowSlash(p2); DoDirSeparators(p2);
if strlen(p1)+strlen(p2)+3>tb_size then if strlen(p1)+strlen(p2)+3>tb_size then
HandleError(217); HandleError(217);
sysseg_move(get_ds,sizeuint(p2),dos_selector,tb,strlen(p2)+1); sysseg_move(get_ds,sizeuint(p2),dos_selector,tb,strlen(p2)+1);
@ -282,7 +273,7 @@ var
action : longint; action : longint;
Avoid6c00 : boolean; Avoid6c00 : boolean;
begin begin
AllowSlash(p); DoDirSeparators(p);
{ check if Extended Open/Create API is safe to use } { check if Extended Open/Create API is safe to use }
Avoid6c00 := lo(dos_version) < 7; Avoid6c00 := lo(dos_version) < 7;
{ close first if opened } { close first if opened }

3
rtl/watcom/system.pp
View File

@ -32,7 +32,10 @@ const
{ LFNSupport is a variable here, defined below!!! } { LFNSupport is a variable here, defined below!!! }
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255; maxExitCode = 255;
MaxPathLen = 256; MaxPathLen = 256;

3
rtl/win/dos.pp
View File

@ -554,8 +554,7 @@ begin
else else
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='/' then dirlist[i]:='\';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then

2
rtl/win/sysdir.inc
View File

@ -27,7 +27,7 @@ var
begin begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer)); DoDirSeparators(pchar(@buffer));
if not aFunc(@buffer) then if not aFunc(@buffer) then
begin begin
errno:=GetLastError; errno:=GetLastError;

17
rtl/win/sysfile.inc
View File

@ -18,15 +18,6 @@
Low Level File Routines Low Level File Routines
*****************************************************************************} *****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
function do_isdevice(handle:thandle):boolean; function do_isdevice(handle:thandle):boolean;
begin begin
{$ifndef WINCE} {$ifndef WINCE}
@ -47,7 +38,7 @@ end;
procedure do_erase(p : pchar); procedure do_erase(p : pchar);
begin begin
AllowSlash(p); DoDirSeparators(p);
if DeleteFile(p)=0 then if DeleteFile(p)=0 then
Begin Begin
errno:=GetLastError; errno:=GetLastError;
@ -63,8 +54,8 @@ end;
procedure do_rename(p1,p2 : pchar); procedure do_rename(p1,p2 : pchar);
begin begin
AllowSlash(p1); DoDirSeparators(p1);
AllowSlash(p2); DoDirSeparators(p2);
if MoveFile(p1,p2)=0 then if MoveFile(p1,p2)=0 then
Begin Begin
errno:=GetLastError; errno:=GetLastError;
@ -214,7 +205,7 @@ Var
oflags,cd : longint; oflags,cd : longint;
security : TSecurityAttributes; security : TSecurityAttributes;
begin begin
AllowSlash(p); DoDirSeparators(p);
{ close first if opened } { close first if opened }
if ((flags and $10000)=0) then if ((flags and $10000)=0) then
begin begin

4
rtl/win32/system.pp
View File

@ -36,7 +36,11 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535; maxExitCode = 65535;
MaxPathLen = 260; MaxPathLen = 260;

3
rtl/win64/system.pp
View File

@ -33,7 +33,10 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535; maxExitCode = 65535;
MaxPathLen = 260; MaxPathLen = 260;

15
rtl/wince/dos.pp
View File

@ -80,7 +80,7 @@ type
Longrec=packed record Longrec=packed record
lo,hi : word; lo,hi : word;
end; end;
Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool; Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
var var
FatDate, FatTime: WORD; FatDate, FatTime: WORD;
@ -247,7 +247,7 @@ begin
GetMem(DriveNames[1], 2*SizeOf(WideChar)); GetMem(DriveNames[1], 2*SizeOf(WideChar));
DriveNames[1][0]:='\'; DriveNames[1][0]:='\';
DriveNames[1][1]:=#0; DriveNames[1][1]:=#0;
// Other drives are found dinamically // Other drives are found dinamically
h:=FindFirstFile('\*', @fd); h:=FindFirstFile('\*', @fd);
if h <> 0 then if h <> 0 then
@ -424,8 +424,7 @@ begin
else else
begin begin
{ allow slash as backslash } { allow slash as backslash }
for i:=1 to length(dirlist) do DoDirSeparators(dirlist);
if dirlist[i]='/' then dirlist[i]:='\';
repeat repeat
p1:=pos(';',dirlist); p1:=pos(';',dirlist);
if p1<>0 then if p1<>0 then
@ -487,13 +486,13 @@ var
l : cardinal; l : cardinal;
buf: array[0..MaxPathLen] of WideChar; buf: array[0..MaxPathLen] of WideChar;
begin begin
if filerec(f).name[1] = #0 then if filerec(f).name[1] = #0 then
begin begin
doserror:=3; doserror:=3;
attr:=0; attr:=0;
end end
else else
begin begin
doserror:=0; doserror:=0;
AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf)); AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
l:=GetFileAttributes(buf); l:=GetFileAttributes(buf);
@ -504,7 +503,7 @@ begin
end end
else else
attr:=l and $ffff; attr:=l and $ffff;
end; end;
end; end;
@ -522,7 +521,7 @@ begin
doserror:=0 doserror:=0
else else
doserror:=Last2DosError(GetLastError); doserror:=Last2DosError(GetLastError);
end; end;
end; end;
{****************************************************************************** {******************************************************************************

3
rtl/wince/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = true; LFNSupport = true;
DirectorySeparator = '\'; DirectorySeparator = '\';
DriveSeparator = ':'; DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';'; PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! } { FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535; maxExitCode = 65535;
MaxPathLen = 260; MaxPathLen = 260;