Merged revisions 3292,3310,3318,3405,3560,3619-3620,3626,3635,3687,3690,3708-3709,3721,3726-3727,3729,3775,3849,3858,3881 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r3292 | jonas | 2006-04-20 12:03:31 +0200 (Thu, 20 Apr 2006) | 6 lines

  * fixed two bugs in ExtractStrings:
    * also extract substrings before the end of the string (but not followed
      anymore by a separator)
    * return the number of substrings in the string even if Strings parameter
      is nil

........
r3310 | michael | 2006-04-21 20:50:26 +0200 (Fri, 21 Apr 2006) | 2 lines

* Fix from [email protected] for frexp function, in case X=0 or X=1

........
r3318 | marco | 2006-04-23 11:55:59 +0200 (Sun, 23 Apr 2006) | 2 lines

 * fix for 4970

........
r3405 | florian | 2006-05-01 20:28:36 +0200 (Mon, 01 May 2006) | 3 lines

+ TBiDiMode
* TLeftRight enabled

........
r3560 | michael | 2006-05-18 14:45:03 +0200 (Thu, 18 May 2006) | 1 line

* Fixed bug #6491, fileextdrive
........
r3619 | peter | 2006-05-21 22:16:59 +0200 (Sun, 21 May 2006) | 2 lines

  * support also ansistring

........
r3620 | peter | 2006-05-21 22:17:17 +0200 (Sun, 21 May 2006) | 2 lines

  * remove dos unit from sysutils

........
r3626 | peter | 2006-05-22 08:57:41 +0200 (Mon, 22 May 2006) | 2 lines

  * fix linux build

........
r3635 | michael | 2006-05-23 09:36:51 +0200 (Tue, 23 May 2006) | 1 line

* Patch from Joost van der Sluis to correct negative date-times
........
r3687 | joost | 2006-05-26 22:55:03 +0200 (Fri, 26 May 2006) | 1 line

 + Several dateutil-fixes for dates before 1899/12/30
........
r3690 | florian | 2006-05-27 10:35:56 +0200 (Sat, 27 May 2006) | 2 lines

* fixes Joost's commit for non unix hopefully

........
r3708 | florian | 2006-05-27 23:30:35 +0200 (Sat, 27 May 2006) | 2 lines

+ added expand defines for all OSes, hopefully no OS forgotten

........
r3709 | florian | 2006-05-27 23:42:00 +0200 (Sat, 27 May 2006) | 2 lines

* part of previous commit

........
r3721 | yury | 2006-05-28 22:30:47 +0200 (Sun, 28 May 2006) | 1 line

* fixed: Message box is not displayed when unhandled exception occurs and SysUtils is used in GUI apps for all Windows targets.
........
r3726 | hajny | 2006-05-28 23:29:26 +0200 (Sun, 28 May 2006) | 1 line

  * fexpand defines kept in platform specific sysutils.pp
........
r3727 | hajny | 2006-05-28 23:40:01 +0200 (Sun, 28 May 2006) | 1 line

  * avoid cutting of HOME variable to 255 characters when compiled with $H+ (sysutils)
........
r3729 | hajny | 2006-05-29 00:27:27 +0200 (Mon, 29 May 2006) | 1 line

  * remove GetEnv dependency
........
r3775 | jonas | 2006-06-03 15:46:40 +0200 (Sat, 03 Jun 2006) | 2 lines

  * initise result of SafeLoadLibrary for non-windows

........
r3849 | vincents | 2006-06-12 19:25:04 +0200 (Mon, 12 Jun 2006) | 2 lines

* fixed typo * fixed typo (issue #7042)

........
r3858 | oro06 | 2006-06-13 10:15:35 +0200 (Tue, 13 Jun 2006) | 1 line

*fix fileopen (please OS2,EMX maintainers have a look)
........
r3881 | hajny | 2006-06-16 22:45:30 +0200 (Fri, 16 Jun 2006) | 1 line

  * comment about FileOpen return value modified
........

git-svn-id: branches/fixes_2_0@3962 -

.gitattributes

@@ -6844,6 +6844,7 @@ tests/webtbs/tw6435.pp svneol=native#text/plain
 tests/webtbs/tw6735.pp svneol=native#text/plain
 tests/webtbs/tw6767.pp svneol=native#text/plain
 tests/webtbs/tw6960.pp svneol=native#text/plain
+tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

rtl/beos/sysutils.pp

@@ -33,6 +33,8 @@ implementation
   uses
     sysconst;
 
+(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/emx/sysutils.pp

@@ -34,6 +34,9 @@ implementation
   uses
     sysconst;
 
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
@@ -406,6 +409,7 @@ asm
 @FOpen1:
  mov eax, 7F2Bh
  call syscall
+(* syscall __open() returns -1 in case of error, i.e. exactly what we need *)
  pop ebx
 end {['eax', 'ebx', 'ecx', 'edx']};
 

rtl/go32v2/sysutils.pp

@@ -33,6 +33,9 @@ implementation
   uses
     sysconst;
 
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/inc/fexpand.inc

@@ -50,7 +50,7 @@
  {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
 {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
 
-procedure GetDirIO (DriveNr: byte; var Dir: OpenString);
+procedure GetDirIO (DriveNr: byte; var Dir: String);
 
 (* GetDirIO is supposed to return the root of the given drive   *)
 (* in case of an error for compatibility of FExpand with TP/BP. *)
@@ -67,7 +67,7 @@ end;
 
 {$IFDEF FPC_FEXPAND_VOLUMES}
  {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
-procedure GetDirIO (const VolumeName: OpenString; var Dir: OpenString);
+procedure GetDirIO (const VolumeName: OpenString; var Dir: string);
 
 var
   OldInOutRes: word;
@@ -91,7 +91,8 @@ function FExpand (const Path: PathStr): PathStr;
    FPC_FEXPAND_NO_DOTS_UPDIR, FPC_FEXPAND_DIRSEP_IS_UPDIR,
    FPC_FEXPAND_DIRSEP_IS_CURDIR and FPC_FEXPAND_MULTIPLE_UPDIR conditionals
    might be defined to specify FExpand behaviour - see end of this file for
-   individual descriptions.
+   individual descriptions. Finally, FPC_FEXPAND_SYSUTILS allows to reuse
+   the same implementation for SysUtils.ExpandFileName.
 *)
 
 {$IFDEF FPC_FEXPAND_DRIVES}
@@ -161,11 +162,15 @@ begin
     if (Length (Pa) >= 1) and (Pa [1] = '~') and
                       ((Pa [2] = DirectorySeparator) or (Length (Pa) = 1)) then
         begin
- {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
+ {$IFDEF FPC_FEXPAND_SYSUTILS}
+            S := GetEnvironmentVariable ('HOME');
+ {$ELSE FPC_FEXPAND_SYSUTILS}
+  {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
             S := StrPas (GetEnv ('HOME'));
- {$ELSE FPC_FEXPAND_GETENV_PCHAR}
+  {$ELSE FPC_FEXPAND_GETENV_PCHAR}
             S := GetEnv ('HOME');
- {$ENDIF FPC_FEXPAND_GETENV_PCHAR}
+  {$ENDIF FPC_FEXPAND_GETENV_PCHAR}
+ {$ENDIF FPC_FEXPAND_SYSUTILS}
             if (S = '') or (Length (S) = 1)
                                           and (S [1] = DirectorySeparator) then
                 Delete (Pa, 1, 1)
@@ -217,7 +222,7 @@ begin
                         begin
                             { remove ending slash if it already exists }
                             if S [Length (S)] = DirectorySeparator then
-                                Dec (S [0]);
+                               SetLength(S,Length(s)-1);
                             Pa := S + DirectorySeparator +
                               Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
                         end
@@ -442,7 +447,7 @@ begin
     else
         if (Length (Dirs) <> 0) and (Dirs [Length (Dirs)] = '.') and
                         (Dirs [Pred (Length (Dirs))] = DirectorySeparator) then
-            Dec (Dirs [0], 2);
+            Delete (Dirs,length(Dirs)-1,2);
 
     {Finally remove '.\' at the beginning of the string of directories...}
     while (Length (Dirs) >= 2) and (Dirs [1] = '.')
@@ -499,7 +504,7 @@ begin
                     and (Length (Path) <> 0)
                           and (Path [Length (Path)] <> DirectorySeparator)
                                                                            then
-        Dec (Pa [0]);
+        Delete (PA,length(PA),1);
 {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
 
     FExpand := Pa;
@@ -573,5 +578,8 @@ end;
    FPC_FEXPAND_MULTIPLE_UPDIR - grouping of more characters specifying
    upper directory references higher directory levels. Example: '...'
    (Netware).
+
+   FPC_FEXPAND_SYSUTILS allows to reuse the same implementation for
+   SysUtils.ExpandFileName by avoiding things specific for unit Dos.
 *)
 

rtl/macos/sysutils.pp

@@ -51,6 +51,12 @@ implementation
 uses
   Dos, Sysconst; // For some included files.
 
+{$DEFINE FPC_FEXPAND_VOLUMES}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$DEFINE FPC_FEXPAND_NO_DOTS_UPDIR}
+{$DEFINE FPC_FEXPAND_NO_CURDIR}
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/morphos/sysutils.pp

@@ -37,6 +37,10 @@ implementation
 
 uses dos,sysconst;
 
+{$DEFINE FPC_FEXPAND_VOLUMES} (* Full paths begin with drive specification *)
+{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/netware/sysutils.pp

@@ -71,6 +71,10 @@ implementation
   uses
     sysconst;
 
+{$define FPC_FEXPAND_DRIVES}
+{$define FPC_FEXPAND_VOLUMES}
+{$define FPC_FEXPAND_NO_DEFAULT_PATHS}
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/netwlibc/sysutils.pp

@@ -73,6 +73,10 @@ implementation
   uses
     sysconst;
 
+{$DEFINE FPC_FEXPAND_DRIVES}
+{$DEFINE FPC_FEXPAND_VOLUMES}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

rtl/objpas/classes/streams.inc

@@ -419,7 +419,8 @@ begin
     FHandle:=FileCreate(AFileName)
   else
     FHAndle:=FileOpen(AFileName,Mode);
-  If FHandle<0 then
+
+  If (FHandle=feInvalidHandle) then
     If Mode=fmcreate then
       raise EFCreateError.createfmt(SFCreateError,[AFileName])
     else
@@ -435,7 +436,8 @@ begin
     FHandle:=FileCreate(AFileName,Rights)
   else
     FHAndle:=FileOpen(AFileName,Mode);
-  If FHandle<0 then
+
+  If (FHandle=feInvalidHandle) then
     If Mode=fmcreate then
       raise EFCreateError.createfmt(SFCreateError,[AFileName])
     else

rtl/objpas/math.pp

@@ -699,24 +699,24 @@ function floor(x : float) : integer;
        Floor := Floor-1;
   end;
 
-procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
 
-  begin
-      Exponent :=0;
-      if (abs(x)<0.5) then
-       While (abs(x)<0.5) do
-       begin
-         x := x*2;
-         Dec(Exponent);
-       end
-      else
-       While (abs(x)>1) do
-       begin
-         x := x/2;
-         Inc(Exponent);
-       end;
-      mantissa := x;
-  end;
+procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
+begin
+  Exponent:=0;
+  if (X<>0) then
+    if (abs(X)<0.5) then
+      repeat
+        X:=X*2;
+        Dec(Exponent);
+      until (abs(X)>=0.5)
+    else
+      while (abs(X)>=1) do 
+        begin
+        X:=X/2;
+        Inc(Exponent);
+        end;
+  Mantissa:=X;
+end;
 
 function ldexp(x : float;const p : Integer) : float;
 

rtl/objpas/rtlconst.inc

@@ -101,7 +101,7 @@ ResourceString
   SDuplicateClass               = 'A class named "%s" already exists';
   SDuplicateItem                = 'Duplicates not allowed in this list ($0%x)';
   SDuplicateMenus               = 'Menu "%s" is used by another form';
-  SDuplicateName                = 'Duplcate name: A component named "%s" already exists';
+  SDuplicateName                = 'Duplicate name: A component named "%s" already exists';
   SDuplicateReference           = 'WriteObject was called twice for one instance';
   SDuplicateString              = 'String list does not allow duplicates';
   SEmptyStreamIllegalReader     = 'Illegal Nil stream for TReader constructor';

rtl/objpas/sysutils/dati.inc

@@ -24,11 +24,6 @@
 {   internal functions                                                         }
 {==============================================================================}
 
-const
-   DayTable: array[Boolean, 1..12] of longint =
-      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
-       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
-
 Function DoEncodeDate(Year, Month, Day: Word): longint;
 
 Var
@@ -48,6 +43,13 @@ begin
     Result:=0;
 end;
 
+function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
+
+begin
+  if Date < 0 then Result := Date - Time
+  else Result := Date + Time;
+end;
+
 {==============================================================================}
 {   Public functions                                                           }
 {==============================================================================}
@@ -56,22 +58,22 @@ end;
 
 function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
 begin
-  result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
-  result.Date := DateDelta + Trunc(System.Int(DateTime));
+  result.Time := Trunc(abs(Frac(DateTime)) * MSecsPerDay);
+  result.Date := DateDelta + trunc(DateTime);
 end ;
 
 {   TimeStampToDateTime converts TimeStamp to a TDateTime value   }
 
 function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
 begin
-  result := (TimeStamp.Date - DateDelta) + (TimeStamp.Time / MSecsPerDay);
-end ;
+  Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time / MSecsPerDay)
+end;
 
 {   MSecsToTimeStamp   }
 
 function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
 begin
-  result.Date := Round(msecs / msecsperday);
+  result.Date := Trunc(msecs / msecsperday);
   msecs:= comp(msecs-result.date*msecsperday);
   result.Time := Round(MSecs);
 end ;
@@ -102,7 +104,10 @@ begin
       end;
      c:= Year DIV 100;
      ya:= Year - 100*c;
-     Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day) - 693900;
+     Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day);
+     // Note that this line can't be part of the line above, since TDateTime is
+     // signed and c and ya are not
+     Date := Date - 693900;
    end
 end;
 
@@ -144,32 +149,41 @@ procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
 var
   ly,ld,lm,j : cardinal;
 begin
-  j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
-  ly:= j DIV 146097;
-  j:= j - 146097 * cardinal(ly);
-  ld := j SHR 2;
-  j:=(ld SHL 2 + 3) DIV 1461;
-  ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
-  lm:=(5 * ld-3) DIV 153;
-  ld:= (5 * ld +2 - 153*lm) DIV 5;
-  ly:= 100 * cardinal(ly) + j;
-  if lm < 10 then
-   inc(lm,3)
+  if Date <= -datedelta then  // If Date is before 1-1-1 then return 0-0-0
+    begin
+    Year := 0;
+    Month := 0;
+    Day := 0;
+    end
   else
     begin
-      dec(lm,9);
-      inc(ly);
+    j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
+    ly:= j DIV 146097;
+    j:= j - 146097 * cardinal(ly);
+    ld := j SHR 2;
+    j:=(ld SHL 2 + 3) DIV 1461;
+    ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
+    lm:=(5 * ld-3) DIV 153;
+    ld:= (5 * ld +2 - 153*lm) DIV 5;
+    ly:= 100 * cardinal(ly) + j;
+    if lm < 10 then
+     inc(lm,3)
+    else
+      begin
+        dec(lm,9);
+        inc(ly);
+      end;
+    year:=ly;
+    month:=lm;
+    day:=ld;
     end;
-  year:=ly;
-  month:=lm;
-  day:=ld;
 end;
 
 
 function DecodeDateFully(const DateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;
 begin
   DecodeDate(DateTime,Year,Month,Day);
-  DOW:=DateTimeToTimeStamp(DateTime).Date mod 7+1;
+  DOW:=DayOfWeek(DateTime);
   Result:=IsLeapYear(Year);
 end;
 
@@ -181,7 +195,7 @@ procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: wor
 Var
   l : cardinal;
 begin
- l := Round(Frac(time) * MSecsPerDay);
+ l := Round(abs(Frac(time)) * MSecsPerDay);
  Hour   := l div 3600000;
  l := l mod 3600000;
  Minute := l div 60000;
@@ -203,8 +217,8 @@ end ;
 
 function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
 begin
-  result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day) +
-            DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
+  result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
+                            DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
 end ;
 
 {   DayOfWeek returns the Day of the week (sunday is day 1)  }
@@ -241,9 +255,8 @@ var
   SystemTime: TSystemTime;
 begin
   GetLocalTime(SystemTime);
-  result := DoEncodeDate(SystemTime.Year,SystemTime.Month,SystemTime.Day) +
-            DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond);
-end ;
+  result := systemTimeToDateTime(SystemTime);
+end;
 
 {   IncMonth increments DateTime with NumberOfMonths months,
     NumberOfMonths can be less than zero   }
@@ -475,7 +488,7 @@ function StrToDateTime(const s: string): TDateTime;
 var i: integer;
 begin
 i := pos(' ', s);
-if i > 0 then result := StrToDate(Copy(S, 1, i - 1)) + StrToTime(Copy(S, i + 1, length(S)))
+if i > 0 then result := ComposeDateTime(StrToDate(Copy(S, 1, i - 1)), StrToTime(Copy(S, i + 1, length(S))))
 else result := StrToDate(S);
 end ;
 
@@ -567,7 +580,7 @@ var
       end ;
    token:=#255;
    lastformattoken:=' ';
-   while FormatCurrent < FormatEnd do 
+   while FormatCurrent < FormatEnd do
      begin
       Token := UpCase(FormatCurrent^);
       Count := 1;
@@ -691,9 +704,8 @@ var
    end ;
 
 begin
-  DecodeDate(DateTime, Year, Month, Day);
+  DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
   DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
-  DayOfWeek := SysUtils.DayOfWeek(DateTime);
   ResultLen := 0;
   ResultCurrent := @ResultBuffer;
   StoreFormat(FormatStr);
@@ -715,17 +727,16 @@ Var YY,MM,DD,H,m,s,msec : Word;
 
 begin
   Decodedate (DateTime,YY,MM,DD);
+  DecodeTime (DateTime,h,m,s,msec);
 {$ifndef unix}
   If (YY<1980) or (YY>2099) then
     Result:=0
   else
     begin
-    DecodeTime (DateTime,h,m,s,msec);
     Result:=(s shr 1) or (m shl 5) or (h shl 11);
     Result:=Result or DD shl 16 or (MM shl 21) or ((YY-1980) shl 25);
     end;
 {$else unix}
-  Decodetime(DateTime,h,m,s,msec);
   Result:=LocalToEpoch(yy,mm,dd,h,m,s);
 {$endif unix}
 end;
@@ -745,15 +756,15 @@ Var Date,Time : Word;
 begin
   Date:=FileDate shr 16;
   Time:=FileDate and $ffff;
-  Result:=EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31) +
-          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0);
+  Result:=ComposeDateTime(EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31),
+          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0));
 end;
 {$else unix}
 var
   y, mon, d, h, min, s: word;
 begin
   EpochToLocal(FileDate,y,mon,d,h,min,s);
-  Result:=EncodeDate(y,mon,d) + EncodeTime(h,min,s,0);
+  Result:=ComposeDateTime(EncodeDate(y,mon,d),EncodeTime(h,min,s,0));
 end;
 {$endif unix}
 
@@ -768,8 +779,8 @@ function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
         result:=false
     end;
   end;
-  
-  
+
+
 // function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
 
 
@@ -783,8 +794,8 @@ function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
         result:=false
     end;
   end;
-  
-  
+
+
 // function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
 
 
@@ -798,8 +809,8 @@ function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
         result:=false
     end;
   end;
-  
-  
+
+
 // function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
 
 

rtl/objpas/sysutils/filutilh.inc

@@ -27,7 +27,7 @@ Type
 {$else unix}
     FindHandle : THandle;
 {$endif unix}
-{$ifdef Win32}
+{$if defined(Win32) or defined(WinCE) or defined(Win64)}
     FindData : TWin32FindData;
 {$endif}
 {$ifdef netware_clib}
@@ -68,23 +68,26 @@ Const
   fsFromCurrent   = 1;
   fsFromEnd       = 2;
 
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-Function FileCreate (Const FileName : String) : Longint;
-Function FileCreate (Const FileName : String; Mode : Integer) : Longint;
-Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
-Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
-Procedure FileClose (Handle : Longint);
-Function FileTruncate (Handle,Size: Longint) : boolean;
+  { File errors }
+  feInvalidHandle : THandle = -1;  //return value on FileOpen error
+
+Function FileOpen (Const FileName : string; Mode : Integer) : THandle;
+Function FileCreate (Const FileName : String) : THandle;
+Function FileCreate (Const FileName : String; Mode : Integer) : THandle;
+Function FileRead (Handle : THandle; Var Buffer; Count : longint) : Longint;
+Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
+Function FileSeek (Handle : THandle;FOffset,Origin : Longint) : Longint;
+Function FileSeek (Handle : THandle; FOffset,Origin : Int64) : Int64;
+Procedure FileClose (Handle : THandle);
+Function FileTruncate (Handle : THandle;Size: Longint) : boolean;
 Function FileAge (Const FileName : String): Longint;
 Function FileExists (Const FileName : String) : Boolean;
 Function DirectoryExists (Const Directory : String) : Boolean;
 Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
 Function FindNext (Var Rslt : TSearchRec) : Longint;
 Procedure FindClose (Var F : TSearchrec);
-Function FileGetDate (Handle : Longint) : Longint;
-Function FileSetDate (Handle,Age : Longint) : Longint;
+Function FileGetDate (Handle : THandle) : Longint;
+Function FileSetDate (Handle : THandle;Age : Longint) : Longint;
 Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
 Function FileGetAttr (Const FileName : String) : Longint;
 Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;

rtl/objpas/sysutils/fina.inc

@@ -53,20 +53,26 @@ Result := Copy(FileName, 1, I);
 end;
 
 function ExtractFileDrive(const FileName: string): string;
-var i: longint;
+
+var
+  i,l: longint;
+
 begin
-if (Length(FileName) >= 2) and (FileName[2] = ':') then
-   result := Copy(FileName, 1, 2)
-else if (Length(FileName) >= 2) and (FileName[1] in ['/', '\']) and
-   (FileName[2] in ['/', '\']) then begin
-   i := 2;
-   While (i < Length(Filename)) do begin
-           if Filename[i + 1] in ['/', '\'] then break;
-      inc(i);
-      end ;
-   Result := Copy(FileName, 1, i);
-   end
-else Result := '';
+  Result := '';
+  l:=Length(FileName);
+  if (L>=2) then
+    begin
+    If (FileName[2]=':') then
+      result:=Copy(FileName,1,2)
+    else if (FileName[1] in ['/','\']) and
+            (FileName[2] in ['/','\']) then
+      begin
+      i := 2;
+      While (i<L) and Not (Filename[i+1] in ['/', '\']) do
+        inc(i);
+      Result:=Copy(FileName,1,i);
+      end;
+    end;
 end;
 
 function ExtractFileName(const FileName: string): string;
@@ -87,6 +93,15 @@ if (I > 0) and (FileName[I] = '.') then
 else Result := '';
 end;
 
+
+  type
+    PathStr=string;
+
+{$DEFINE FPC_FEXPAND_SYSUTILS}
+
+{$I fexpand.inc}
+
+
 function ExpandFileName (Const FileName : string): String;
 
 Var S : String;
@@ -94,11 +109,7 @@ Var S : String;
 Begin
  S:=FileName;
  DoDirSeparators(S);
-{$ifdef HasUnix}
-  Result:=fexpand(S);
-{$else}
-  Result:=Dos.Fexpand(S);
-{$endif}
+ Result:=Fexpand(S);
 end;
 
 

rtl/objpas/sysutils/sysutils.inc

@@ -65,7 +65,7 @@
 
   begin
     fd:=FileOpen(FileName,fmOpenRead);
-    If (Fd>=0) then
+    If (Fd<>feInvalidHandle) then
       try
         Result:=FileSetDate(fd,Age);
       finally
@@ -248,6 +248,7 @@ begin
       for i:=0 to FrameCount-1 do
         Writeln(stdout,BackTraceStrFunc(Frames[i]));
     end;
+  Writeln(stdout,'');
   Halt(217);
 end;
 
@@ -576,3 +577,34 @@ begin
     end;
 end;
 
+
+function SafeLoadLibrary(const FileName: AnsiString;
+  ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;
+  var
+    mode : DWord;
+{$if defined(cpui386) or defined(cpux86_64)}
+    fpucw : Word;
+    ssecw : DWord;
+{$endif}
+  begin
+{$if defined(win64) or defined(win32)}
+    mode:=SetErrorMode(ErrorMode);
+{$endif}
+    try
+{$if defined(cpui386) or defined(cpux86_64)}
+      fpucw:=Get8087CW;
+{$endif}      
+{$if defined(windows) or defined(win32)}
+      Result:=LoadLibraryA(PChar(Filename));
+{$else}
+      Result:=0;
+{$endif}
+      finally
+{$if defined(cpui386) or defined(cpux86_64)}
+      Set8087CW(fpucw);
+{$endif}
+{$if defined(win64) or defined(win32)}
+      SetErrorMode(mode);
+{$endif}
+    end;
+  end;

rtl/os2/sysutils.pp

@@ -34,6 +34,9 @@ implementation
   uses
     sysconst;
 
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
@@ -463,7 +466,8 @@ begin
   If Rc=0 then
     FileOpen:=Handle
   else
-    FileOpen:=-RC;
+    FileOpen:=feInvalidHandle; //FileOpen:=-RC;
+    //should return feInvalidHandle(=-1) if fail, other negative returned value are no more errors
 end;
 
 function FileCreate (const FileName: string): longint;

rtl/unix/sysutils.pp

@@ -86,24 +86,9 @@ procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
 
 {$Define OS_FILEISREADONLY} // Specific implementation for Unix.
 
-Function getenv(name:shortstring):Pchar; external name 'FPC_SYSC_FPGETENV';
-
-Type
-  ComStr  = String[255];
-  PathStr = String[255];
-  DirStr  = String[255];
-  NameStr = String[255];
-  ExtStr  = String[255];
-
-
 {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
 {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
 
-{$I fexpand.inc}
-
-{$UNDEF FPC_FEXPAND_GETENVPCHAR}
-{$UNDEF FPC_FEXPAND_TILDE}
-
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
@@ -333,7 +318,7 @@ Function Dirname(Const path:pathstr):pathstr;
   a slash.
 }
 var
-  Dir  : PathStr;
+  Dir  : DirStr;
   Name : NameStr;
   Ext  : ExtStr;
 begin
@@ -350,7 +335,7 @@ Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
   supplied, it is cut off the filename.
 }
 var
-  Dir  : PathStr;
+  Dir  : DirStr;
   Name : NameStr;
   Ext  : ExtStr;
 begin
@@ -1083,14 +1068,14 @@ begin
     Result:=IncludeTrailingPathDelimiter(Result);
 end;
 
-{ Follows base-dir spec, 
+{ Follows base-dir spec,
   see [http://freedesktop.org/Standards/basedir-spec].
   Always ends with PathDelim. }
 Function XdgConfigHome : String;
 begin
   Result:=GetEnvironmentVariable('XDG_CONFIG_HOME');
   if (Result='') then
-    Result:=GetHomeDir + '.config/' 
+    Result:=GetHomeDir + '.config/'
   else
     Result:=IncludeTrailingPathDelimiter(Result);
 end;

rtl/watcom/sysutils.pp

@@ -33,6 +33,9 @@ implementation
   uses
     sysconst;
 
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
 { Include platform independent implementation part }
 {$i sysutils.inc}
 

tests/webtbs/tw6980.pp

@@ -0,0 +1,19 @@
+{ %target=win32,go32v2,win64 }
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils
+  { add your units here };
+
+var
+  p: string;
+  e: string;
+begin
+  p := 'C:\test';
+  e := ExpandFileName('c:\test');
+  writeln('Expanded: ',e);
+  if (p<>e) then halt(1);
+  writeln('ok');
+end.