Bläddra i källkod

* Fix for bug ID #18551

git-svn-id: trunk@27773 -
michael 11 år sedan
förälder
incheckning
17e34abc62
3 ändrade filer med 9 tillägg och 22 borttagningar
  1. 1 0
      rtl/inc/systemh.inc
  2. 8 1
      rtl/objpas/sysutils/fina.inc
  3. 0 21
      rtl/unix/sysutils.pp

+ 1 - 0
rtl/inc/systemh.inc

@@ -674,6 +674,7 @@ var
 {$endif FPC_HAS_FEATURE_DYNLIBS}
   IsConsole : boolean = false; public name 'operatingsystem_isconsole';
   NoErrMsg: Boolean platform = False; // For Delphi compatibility, not used in FPC.
+  FirstDotAtFileNameStartIsExtension : Boolean = False;
   
   DefaultSystemCodePage,
   DefaultUnicodeCodePage,

+ 8 - 1
rtl/objpas/sysutils/fina.inc

@@ -105,13 +105,20 @@ function ExtractFileExt(const FileName: PathStr): PathStr;
 var
   i : longint;
   EndSep : Set of Char;
+  SOF : Boolean; // Dot at Start of filename ?
+  
 begin
+  Result:='';
   I := Length(FileName);
   EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
   while (I > 0) and not CharInSet(FileName[I],EndSep) do
     Dec(I);
   if (I > 0) and (FileName[I] = ExtensionSeparator) then
-    Result := Copy(FileName, I, MaxInt)
+    begin
+	SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
+	if (Not SOF) or FirstDotAtFileNameStartIsExtension then
+	  Result := Copy(FileName, I, MaxInt);
+	end  
   else
     Result := '';
 end;

+ 0 - 21
rtl/unix/sysutils.pp

@@ -357,27 +357,6 @@ end;
 
 
 
-Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
-Var
-  DotPos,SlashPos,i : longint;
-Begin
-  SlashPos:=0;
-  DotPos:=256;
-  i:=Length(Path);
-  While (i>0) and (SlashPos=0) Do
-   Begin
-     If (DotPos=256) and (Path[i]='.') Then
-      begin
-        DotPos:=i;
-      end;
-     If (Path[i]='/') Then
-      SlashPos:=i;
-     Dec(i);
-   End;
-  Ext:=Copy(Path,DotPos,255);
-  Dir:=Copy(Path,1,SlashPos);
-  Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
-End;
 
 
 Function DoFileLocking(Handle: Longint; Mode: Integer) : Longint;