Browse Source

Merged revisions 9049,9059,9074,9076-9082,9084,9086,9088-9090,9096,9108,9114,9132-9133,9185,9211,9236-9238,9260,9262,9266,9269-9272,9276-9278,9295,9301,9307-9308,9310,9322,9337,9340,9343-9344,9359,9373-9375,9387,9396,9399,9401-9402,9434,9450-9456,9459-9463,9466,9468-9469,9472-9473,9476-9477,9480,9491-9492,9529,9536,9550,9566-9568,9571-9573,9576-9577,9579,9583,9587,9604,9617,9632-9637,9649,9655-9656,9658,9692,9694-9695,9697-9714,9720,9722,9729,9732-9733,9740,9745,9749-9750,9753-9757,9760-9766,9768-9770,9772-9775,9814,9822,9824 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r9049 | yury | 2007-11-01 17:15:29 +0100 (Thu, 01 Nov 2007) | 1 line

* Do not fill generic upcase and lowcase conversion tables for windows targets, because generic ANSI routines are not used here.
........
r9301 | yury | 2007-11-20 11:45:50 +0100 (Tue, 20 Nov 2007) | 1 line

* Removed UpperCaseTable and LowerCaseTable variables and TCaseTranslationTable type from interface part. These variables are used only by generic upper/lower case conversion routines. They are not used on Windows targets and it is bad idea to let users use these variables. Users must use AnsiLowerCase and AnsiUpperCase routines.
........
r9572 | michael | 2007-12-29 20:03:56 +0100 (Sat, 29 Dec 2007) | 1 line

* Patch from Sergei Gorelkin, making TStream.Read and .Write virtual
........
r9604 | mazen | 2007-12-31 17:34:45 +0100 (Mon, 31 Dec 2007) | 2 lines

* Added implementation for Julian date computaton.
........
r9617 | jonas | 2008-01-02 20:53:14 +0100 (Wed, 02 Jan 2008) | 3 lines

* declare math.pinteger as an alias of objpas.pinteger to avoid type
masking errors (mantis #10540)
........
r9649 | peter | 2008-01-06 13:45:03 +0100 (Sun, 06 Jan 2008) | 2 lines

* disable range/overflow checking when calculating with Nan
........
r9775 | michael | 2008-01-16 17:15:05 +0100 (Wed, 16 Jan 2008) | 1 line

* Fixed IsEmptyStr
........
r9824 | marco | 2008-01-20 21:38:54 +0100 (Sun, 20 Jan 2008) | 2 lines

* fix for 10577
........

git-svn-id: branches/fixes_2_2@9855 -

peter 17 years ago
parent
commit
6deff9655e

+ 1 - 0
.gitattributes

@@ -7820,6 +7820,7 @@ tests/webtbs/tw10454.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
 tests/webtbs/tw10519.pp svneol=native#text/plain
 tests/webtbs/tw10519.pp svneol=native#text/plain
+tests/webtbs/tw10540.pp svneol=native#text/plain
 tests/webtbs/tw1061.pp svneol=native#text/plain
 tests/webtbs/tw1061.pp svneol=native#text/plain
 tests/webtbs/tw1066a.pp svneol=native#text/plain
 tests/webtbs/tw1066a.pp svneol=native#text/plain
 tests/webtbs/tw1066b.pp svneol=native#text/plain
 tests/webtbs/tw1066b.pp svneol=native#text/plain

+ 0 - 12
packages/fcl-base/src/inc/base64.pp

@@ -40,7 +40,6 @@ type
     constructor Create(AOutputStream: TStream);
     constructor Create(AOutputStream: TStream);
     destructor Destroy; override;
     destructor Destroy; override;
 
 
-    function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
   end;
   end;
@@ -81,7 +80,6 @@ type
     procedure Reset;
     procedure Reset;
 
 
     function Read(var Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     
     
     property EOF: Boolean read fEOF;
     property EOF: Boolean read fEOF;
@@ -158,11 +156,6 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
-function TBase64EncodingStream.Read(var Buffer; Count: Longint): Longint;
-begin
-  raise EStreamError.Create('Invalid stream operation');
-end;
-
 function TBase64EncodingStream.Write(const Buffer; Count: Longint): Longint;
 function TBase64EncodingStream.Write(const Buffer; Count: Longint): Longint;
 var
 var
   ReadNow: LongInt;
   ReadNow: LongInt;
@@ -413,11 +406,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TBase64DecodingStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  raise EStreamError.Create('Invalid stream operation');
-end;
-
 function TBase64DecodingStream.Seek(Offset: Longint; Origin: Word): Longint;
 function TBase64DecodingStream.Seek(Offset: Longint; Origin: Word): Longint;
 begin
 begin
   // TODO: implement Seeking in TBase64DecodingStream
   // TODO: implement Seeking in TBase64DecodingStream

+ 0 - 15
packages/fcl-base/src/inc/blowfish.pp

@@ -63,7 +63,6 @@ Type
   TBlowFishEncryptStream = Class(TBlowFishStream)
   TBlowFishEncryptStream = Class(TBlowFishStream)
   public
   public
     Destructor Destroy; override;
     Destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     procedure Flush;
     procedure Flush;
@@ -72,7 +71,6 @@ Type
   TBlowFishDeCryptStream = Class(TBlowFishStream)
   TBlowFishDeCryptStream = Class(TBlowFishStream)
   public
   public
     function Read(var Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
   end;
   end;
 
 
@@ -80,8 +78,6 @@ Implementation
 
 
 ResourceString
 ResourceString
   SNoSeekAllowed  = 'Seek not allowed on encryption streams';
   SNoSeekAllowed  = 'Seek not allowed on encryption streams';
-  SNoReadAllowed  = 'Reading from encryption stream not allowed';
-  SNoWriteAllowed = 'Writing to decryption stream not allowed';
 
 
 { Blowfish lookup tables }
 { Blowfish lookup tables }
 
 
@@ -581,12 +577,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-function TBlowFishEncryptStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Raise EBlowFishError.Create(SNoReadAllowed);
-end;
-
 function TBlowFishEncryptStream.Write(const Buffer; Count: Longint): Longint;
 function TBlowFishEncryptStream.Write(const Buffer; Count: Longint): Longint;
 
 
 Var
 Var
@@ -673,11 +663,6 @@ begin
   Inc(FPos,Result);
   Inc(FPos,Result);
 end;
 end;
 
 
-function TBlowFishDeCryptStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  Raise EBlowFishError.Create(SNoWriteAllowed);
-end;
-
 function TBlowFishDeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 function TBlowFishDeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 
 
 Var Buffer : Array[0..1023] of byte;
 Var Buffer : Array[0..1023] of byte;

+ 2 - 16
packages/fcl-base/src/inc/bufstream.pp

@@ -38,7 +38,7 @@ Type
     FCapacity: Integer;
     FCapacity: Integer;
     procedure SetCapacity(const AValue: Integer);
     procedure SetCapacity(const AValue: Integer);
   Protected
   Protected
-    procedure BufferError(Msg : String);
+    procedure BufferError(const Msg : String);
     Procedure FillBuffer; Virtual;
     Procedure FillBuffer; Virtual;
     Procedure FlushBuffer; Virtual;
     Procedure FlushBuffer; Virtual;
   Public
   Public
@@ -57,7 +57,6 @@ Type
   Public
   Public
     Function Seek(Offset: Longint; Origin: Word): Longint; override;
     Function Seek(Offset: Longint; Origin: Word): Longint; override;
     Function Read(var ABuffer; ACount : LongInt) : Integer; override;
     Function Read(var ABuffer; ACount : LongInt) : Integer; override;
-    Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   end;
   end;
 
 
   { TWriteBufStream }
   { TWriteBufStream }
@@ -66,7 +65,6 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Function Seek(Offset: Longint; Origin: Word): Longint; override;
     Function Seek(Offset: Longint; Origin: Word): Longint; override;
-    Function Read(var ABuffer; ACount : LongInt) : Integer; override;
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   end;
   end;
 
 
@@ -75,8 +73,6 @@ implementation
 Resourcestring
 Resourcestring
   SErrCapacityTooSmall = 'Capacity is less than actual buffer size.';
   SErrCapacityTooSmall = 'Capacity is less than actual buffer size.';
   SErrCouldNotFLushBuffer = 'Could not flush buffer';
   SErrCouldNotFLushBuffer = 'Could not flush buffer';
-  SErrWriteOnlyStream = 'Illegal stream operation: Only writing is allowed.';
-  SErrReadOnlyStream = 'Illegal stream operation: Only reading is allowed.';
   SErrInvalidSeek = 'Invalid buffer seek operation';
   SErrInvalidSeek = 'Invalid buffer seek operation';
 
 
 { TBufStream }
 { TBufStream }
@@ -92,7 +88,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TBufStream.BufferError(Msg: String);
+procedure TBufStream.BufferError(const Msg: String);
 begin
 begin
   Raise EStreamError.Create(Msg);
   Raise EStreamError.Create(Msg);
 end;
 end;
@@ -222,11 +218,6 @@ begin
   Inc(FTotalPos,Result);
   Inc(FTotalPos,Result);
 end;
 end;
 
 
-function TReadBufStream.Write(const ABuffer; ACount: LongInt): Integer;
-begin
-  BufferError(SErrReadOnlyStream);
-end;
-
 { TWriteBufStream }
 { TWriteBufStream }
 
 
 destructor TWriteBufStream.Destroy;
 destructor TWriteBufStream.Destroy;
@@ -243,11 +234,6 @@ begin
     BufferError(SErrInvalidSeek);
     BufferError(SErrInvalidSeek);
 end;
 end;
 
 
-function TWriteBufStream.Read(var ABuffer; ACount: LongInt): Integer;
-begin
-  BufferError(SErrWriteOnlyStream);
-end;
-
 function TWriteBufStream.Write(const ABuffer; ACount: LongInt): Integer;
 function TWriteBufStream.Write(const ABuffer; ACount: LongInt): Integer;
 
 
 Var
 Var

+ 0 - 15
packages/fcl-base/src/inc/idea.pp

@@ -85,7 +85,6 @@ Type
   TIDEAEncryptStream = Class(TIDEAStream)
   TIDEAEncryptStream = Class(TIDEAStream)
   public
   public
     Destructor Destroy; override;
     Destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     procedure Flush;
     procedure Flush;
@@ -94,7 +93,6 @@ Type
   TIDEADeCryptStream = Class(TIDEAStream)
   TIDEADeCryptStream = Class(TIDEAStream)
   public
   public
     function Read(var Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
   end;
   end;
 
 
@@ -102,8 +100,6 @@ Implementation
 
 
 Const
 Const
   SNoSeekAllowed  = 'Seek not allowed on encryption streams';
   SNoSeekAllowed  = 'Seek not allowed on encryption streams';
-  SNoReadAllowed  = 'Reading from encryption stream not allowed';
-  SNoWriteAllowed = 'Writing to decryption stream not allowed';
 
 
 PROCEDURE mul(VAR a:Word; b: Word);
 PROCEDURE mul(VAR a:Word; b: Word);
 VAR p: LongInt;
 VAR p: LongInt;
@@ -288,12 +284,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-function TIDEAEncryptStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Raise EIDEAError.Create(SNoReadAllowed);
-end;
-
 function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint;
 function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint;
 
 
 Var
 Var
@@ -382,11 +372,6 @@ begin
   Inc(FPos,Result);
   Inc(FPos,Result);
 end;
 end;
 
 
-function TIDEADeCryptStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  Raise EIDEAError.Create(SNoWriteAllowed);
-end;
-
 function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 
 
 Var Buffer : Array[0..1023] of byte;
 Var Buffer : Array[0..1023] of byte;

+ 4 - 6
packages/fcl-process/src/pipes.pp

@@ -23,8 +23,6 @@ Uses sysutils,Classes;
 
 
 Type
 Type
   EPipeError = Class(EStreamError);
   EPipeError = Class(EStreamError);
-  ENoReadPipe = Class(EPipeError);
-  ENoWritePipe = Class (EPipeError);
   EPipeSeek = Class (EPipeError);
   EPipeSeek = Class (EPipeError);
   EPipeCreation = Class (EPipeError);
   EPipeCreation = Class (EPipeError);
 
 
@@ -52,8 +50,6 @@ Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
                              Var OutPipe : TOutputPipeStream);
                              Var OutPipe : TOutputPipeStream);
 
 
 Const EPipeMsg = 'Failed to create pipe.';
 Const EPipeMsg = 'Failed to create pipe.';
-      ENoReadMSg = 'Cannot read from OuputPipeStream.';
-      ENoWriteMsg = 'Cannot write to InputPipeStream.';
       ENoSeekMsg = 'Cannot seek on pipes';
       ENoSeekMsg = 'Cannot seek on pipes';
 
 
 
 
@@ -79,7 +75,8 @@ end;
 Function TInputPipeStream.Write (Const Buffer; Count : Longint) : longint;
 Function TInputPipeStream.Write (Const Buffer; Count : Longint) : longint;
 
 
 begin
 begin
-  Raise ENoWritePipe.Create (ENoWriteMsg);
+  WriteNotImplemented;
+  Result := 0;
 end;
 end;
 
 
 Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
 Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
@@ -115,7 +112,8 @@ end;
 Function TOutputPipeStream.Read(Var Buffer; Count : Longint) : longint;
 Function TOutputPipeStream.Read(Var Buffer; Count : Longint) : longint;
 
 
 begin
 begin
-  Raise ENoReadPipe.Create (ENoReadMsg);
+  ReadNotImplemented;
+  Result := 0;
 end;
 end;
 
 
 Function TOutputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
 Function TOutputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;

+ 24 - 8
rtl/objpas/classes/streams.inc

@@ -14,6 +14,29 @@
 {*                             TStream                                      *}
 {*                             TStream                                      *}
 {****************************************************************************}
 {****************************************************************************}
 
 
+procedure TStream.ReadNotImplemented;
+begin
+  raise EStreamError.CreateFmt(SStreamNoReading, [ClassName]) at get_caller_addr(get_frame);
+end;
+
+procedure TStream.WriteNotImplemented;
+begin
+  raise EStreamError.CreateFmt(SStreamNoWriting, [ClassName]) at get_caller_addr(get_frame);
+end;
+
+function TStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  ReadNotImplemented;
+  Result := 0;
+end;
+
+function TStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  WriteNotImplemented;
+  Result := 0;
+end;
+
+
   function TStream.GetPosition: Int64;
   function TStream.GetPosition: Int64;
 
 
     begin
     begin
@@ -340,7 +363,7 @@
      end;
      end;
    end;
    end;
 
 
-  Procedure TStream.WriteAnsiString (S : String);
+  Procedure TStream.WriteAnsiString (const S : String);
 
 
   Var L : Longint;
   Var L : Longint;
 
 
@@ -771,13 +794,6 @@ destructor TResourceStream.Destroy;
     inherited destroy;
     inherited destroy;
   end;
   end;
 
 
-{$warnings off}
-function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-  begin
-    raise EStreamError.Create(SCantWriteResourceStreamError);
-  end;
-{$warnings on}
-
 {****************************************************************************}
 {****************************************************************************}
 {*                             TOwnerStream                                 *}
 {*                             TOwnerStream                                 *}
 {****************************************************************************}
 {****************************************************************************}

+ 29 - 15
rtl/objpas/dateutil.inc

@@ -1976,23 +1976,34 @@ end;
     Julian and Modified Julian Date conversion support
     Julian and Modified Julian Date conversion support
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-{$warnings off}
+{$ifopt R+}
+{$define RangeCheckWasOn}
+{$R-}
+{$endif opt R+}
+
+{$ifopt Q+}
+{$define OverflowCheckWasOn}
+{$Q-}
+{$endif opt Q+}
+
 Function DateTimeToJulianDate(const AValue: TDateTime): Double;
 Function DateTimeToJulianDate(const AValue: TDateTime): Double;
 begin
 begin
-  NotYetImplemented('DateTimeToJulianDate');
+  DateTimeToJulianDate := AValue - JulianEpoch;
 end;
 end;
 
 
 
 
 Function JulianDateToDateTime(const AValue: Double): TDateTime;
 Function JulianDateToDateTime(const AValue: Double): TDateTime;
 begin
 begin
-  NotYetImplemented('JulianDateToDateTime');
+  JulianDateToDateTime := AValue + JulianEpoch;
+  if(AValue <= 0) or (AValue >= 10000)then
+    JulianDateToDateTime := NaN;
 end;
 end;
 
 
 
 
 Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
 Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
-
 begin
 begin
-  NotYetImplemented('TryJulianDateToDateTime');
+  ADateTime := JulianDateToDateTime(AValue);
+  TryJulianDateToDateTime := ADateTime <> NaN;
 end;
 end;
 
 
 
 
@@ -2013,27 +2024,30 @@ Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TD
 begin
 begin
   NotYetImplemented('TryModifiedJulianDateToDateTime');
   NotYetImplemented('TryModifiedJulianDateToDateTime');
 end;
 end;
-{$warnings on}
+
+{$ifdef RangeCheckWasOn}
+{$R+}
+{$undef RangeCheckWasOn}
+{$endif}
+
+{$ifdef OverflowCheckWasOn}
+{$Q+}
+{$undef OverflowCheckWasOn}
+{$endif}
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     Unix timestamp support.
     Unix timestamp support.
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 Function DateTimeToUnix(const AValue: TDateTime): Int64;
 Function DateTimeToUnix(const AValue: TDateTime): Int64;
-var
-  Epoch:TDateTime;
 begin
 begin
-  Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
-  Result:=SecondsBetween( Epoch, AValue );
+  Result:=SecondsBetween(UnixEpoch, AValue);
 end;
 end;
 
 
 
 
 Function UnixToDateTime(const AValue: Int64): TDateTime;
 Function UnixToDateTime(const AValue: Int64): TDateTime;
-var
-  Epoch:TDateTime;
 begin
 begin
-  Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
-  Result:=IncSecond( Epoch, AValue );
+  Result:=IncSecond(UnixEpoch, AValue);
 end;
 end;
 
 
 
 
@@ -2068,7 +2082,7 @@ end;
 
 
 Function MacTimeStampToUnix(const AValue: Int64): Int64;
 Function MacTimeStampToUnix(const AValue: Int64): Int64;
 const
 const
-  Epoch=24107 * 24 * 3600; 
+  Epoch=24107 * 24 * 3600;
 begin
 begin
   Result:=AValue - Epoch;
   Result:=AValue - Epoch;
 end;
 end;

+ 1 - 1
rtl/objpas/math.pp

@@ -96,7 +96,7 @@ interface
 
 
     type
     type
        PFloat = ^Float;
        PFloat = ^Float;
-       PInteger = ^Integer;
+       PInteger = ObjPas.PInteger;
 
 
        tpaymenttime = (ptendofperiod,ptstartofperiod);
        tpaymenttime = (ptendofperiod,ptstartofperiod);
 
 

+ 2 - 0
rtl/objpas/rtlconst.inc

@@ -248,6 +248,8 @@ ResourceString
   SSocketRead                   = 'Read';
   SSocketRead                   = 'Read';
   SSocketWrite                  = 'Write';
   SSocketWrite                  = 'Write';
   SSortedListError              = 'Operation not allowed on sorted list';
   SSortedListError              = 'Operation not allowed on sorted list';
+  SStreamNoReading              = 'Reading from %s is not supported';
+  SStreamNoWriting              = 'Writing to %s is not supported';
   SStreamSetSize                = 'Error setting stream size';
   SStreamSetSize                = 'Error setting stream size';
   SStringExpected               = 'String expected';
   SStringExpected               = 'String expected';
   SSymbolExpected               = '%s expected';
   SSymbolExpected               = '%s expected';

+ 1 - 1
rtl/objpas/strutils.pp

@@ -908,7 +908,7 @@ begin
   Result:=True;
   Result:=True;
   while Result and (i<=l) do
   while Result and (i<=l) do
     begin
     begin
-    Result:=Not (S[i] in EmptyChars);
+    Result:=(S[i] in EmptyChars);
     Inc(i);
     Inc(i);
     end;
     end;
 end;
 end;

+ 7 - 1
rtl/objpas/sysutils/datih.inc

@@ -34,8 +34,14 @@ const
    SecsPerDay  = MinsPerDay * SecsPerMin;
    SecsPerDay  = MinsPerDay * SecsPerMin;
    MSecsPerDay = SecsPerDay * MSecsPerSec;
    MSecsPerDay = SecsPerDay * MSecsPerSec;
 
 
+{TDateTime holds the date as the number of days since 30 Dec 1899, known as
+Microsoft Excel epoch}
+   JulianEpoch = TDateTime(-2415018.5);
+   UnixEpoch = JulianEpoch + TDateTime(2440587.5);
+
    DateDelta = 693594;        // Days between 1/1/0001 and 12/31/1899
    DateDelta = 693594;        // Days between 1/1/0001 and 12/31/1899
-   UnixDateDelta = 25569;
+   UnixDateDelta = Trunc(UnixEpoch); //25569
+
 
 
    { True=Leapyear }
    { True=Leapyear }
    MonthDays: array [Boolean] of TDayTable =
    MonthDays: array [Boolean] of TDayTable =

+ 0 - 6
rtl/objpas/sysutils/sysinth.inc

@@ -27,7 +27,6 @@
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 type
 type
-  TCaseTranslationTable = array[0..255] of char;
   TMonthNameArray = array[1..12] of string;
   TMonthNameArray = array[1..12] of string;
   TWeekNameArray = array[1..7] of string;
   TWeekNameArray = array[1..7] of string;
 
 
@@ -55,11 +54,6 @@ type
   end;
   end;
 
 
 var
 var
-   { Tables with upper and lowercase forms of character sets.
-     MUST be initialized with the correct code-pages }
-   UpperCaseTable: TCaseTranslationTable;
-   LowerCaseTable: TCaseTranslationTable;
-
   DefaultFormatSettings : TFormatSettings = (
   DefaultFormatSettings : TFormatSettings = (
     CurrencyFormat: 1;
     CurrencyFormat: 1;
     NegCurrFormat: 5;
     NegCurrFormat: 5;

+ 26 - 13
rtl/objpas/sysutils/sysstr.inc

@@ -221,11 +221,21 @@ begin
  Result:=CompareText(S1,S2)=0;
  Result:=CompareText(S1,S2)=0;
 end;
 end;
 
 
+{$ifndef FPC_NOGENERICANSIROUTINES}
 {==============================================================================}
 {==============================================================================}
 {   Ansi string functions                                                      }
 {   Ansi string functions                                                      }
 {   these functions rely on the character set loaded by the OS                 }
 {   these functions rely on the character set loaded by the OS                 }
 {==============================================================================}
 {==============================================================================}
 
 
+type
+  TCaseTranslationTable = array[0..255] of char;
+  
+var
+  { Tables with upper and lowercase forms of character sets.
+    MUST be initialized with the correct code-pages }
+  UpperCaseTable: TCaseTranslationTable;
+  LowerCaseTable: TCaseTranslationTable;
+
 function GenericAnsiUpperCase(const s: string): string;
 function GenericAnsiUpperCase(const s: string): string;
   var
   var
     len, i: integer;
     len, i: integer;
@@ -282,18 +292,6 @@ begin
     Result:=L1-L2;
     Result:=L1-L2;
 end;
 end;
 
 
-function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
-
-begin
- AnsiSameText:=AnsiCompareText(S1,S2)=0;
-end;
-
-function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
-
-begin
-  AnsiSameStr:=AnsiCompareStr(S1,S2)=0;
-end;
-
 function GenericAnsiStrComp(S1, S2: PChar): PtrInt;
 function GenericAnsiStrComp(S1, S2: PChar): PtrInt;
 
 
 begin
 begin
@@ -423,6 +421,19 @@ if Str <> Nil then begin
       end ;
       end ;
    end ;
    end ;
 end ;
 end ;
+{$endif FPC_NOGENERICANSIROUTINES}
+
+function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
+ AnsiSameText:=AnsiCompareText(S1,S2)=0;
+end;
+
+function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
+  AnsiSameStr:=AnsiCompareStr(S1,S2)=0;
+end;
 
 
 function AnsiLastChar(const S: string): PChar;
 function AnsiLastChar(const S: string): PChar;
 
 
@@ -2601,12 +2612,13 @@ begin
 end;
 end;
 
 
 
 
+{$ifndef FPC_NOGENERICANSIROUTINES}
 {
 {
    Case Translation Tables
    Case Translation Tables
    Can be used in internationalization support.
    Can be used in internationalization support.
 
 
    Although these tables can be obtained through system calls
    Although these tables can be obtained through system calls
-   it is better to not use those, since most implementation are not 100%
+cd    it is better to not use those, since most implementation are not 100%
    WARNING:
    WARNING:
    before modifying a translation table make sure that the current codepage
    before modifying a translation table make sure that the current codepage
    of the OS corresponds to the one you make changes to
    of the OS corresponds to the one you make changes to
@@ -2659,6 +2671,7 @@ const
      #240, #241, #242, #243, #244, #245, #246, #247,
      #240, #241, #242, #243, #244, #245, #246, #247,
      #248, #249, #250, #251, #252, #253, #254, #255 );
      #248, #249, #250, #251, #252, #253, #254, #255 );
 
 
+{$endif FPC_NOGENERICANSIROUTINES}
 
 
 function sscanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;
 function sscanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;
   var
   var

+ 0 - 24
rtl/win/sysutils.pp

@@ -613,29 +613,6 @@ end;
                               Locale Functions
                               Locale Functions
 ****************************************************************************}
 ****************************************************************************}
 
 
-Procedure InitAnsi;
-Var
-  i : longint;
-begin
-  {  Fill table entries 0 to 127  }
-  for i := 0 to 96 do
-    UpperCaseTable[i] := chr(i);
-  for i := 97 to 122 do
-    UpperCaseTable[i] := chr(i - 32);
-  for i := 123 to 191 do
-    UpperCaseTable[i] := chr(i);
-  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-  for i := 0 to 64 do
-    LowerCaseTable[i] := chr(i);
-  for i := 65 to 90 do
-    LowerCaseTable[i] := chr(i + 32);
-  for i := 91 to 191 do
-    LowerCaseTable[i] := chr(i);
-  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
 function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 var
 var
   L: Integer;
   L: Integer;
@@ -732,7 +709,6 @@ begin
   // probably needs update with getthreadlocale. post 2.0.2
   // probably needs update with getthreadlocale. post 2.0.2
 
 
   Set8087CW(old8087CW);
   Set8087CW(old8087CW);
-  InitAnsi;
   GetFormatSettings;
   GetFormatSettings;
 end;
 end;
 
 

+ 0 - 24
rtl/wince/sysutils.pp

@@ -485,29 +485,6 @@ end;
                               Locale Functions
                               Locale Functions
 ****************************************************************************}
 ****************************************************************************}
 
 
-Procedure InitAnsi;
-Var
-  i : longint;
-begin
-  {  Fill table entries 0 to 127  }
-  for i := 0 to 96 do
-    UpperCaseTable[i] := chr(i);
-  for i := 97 to 122 do
-    UpperCaseTable[i] := chr(i - 32);
-  for i := 123 to 191 do
-    UpperCaseTable[i] := chr(i);
-  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-  for i := 0 to 64 do
-    LowerCaseTable[i] := chr(i);
-  for i := 65 to 90 do
-    LowerCaseTable[i] := chr(i + 32);
-  for i := 91 to 191 do
-    LowerCaseTable[i] := chr(i);
-  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
 function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 var
 var
   L: Integer;
   L: Integer;
@@ -614,7 +591,6 @@ begin
   InitInternationalGeneric;
   InitInternationalGeneric;
   SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
   SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
   SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
   SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
-  InitAnsi;
   GetFormatSettings;
   GetFormatSettings;
 end;
 end;
 
 

+ 25 - 0
tests/webtbs/tw10540.pp

@@ -0,0 +1,25 @@
+{ %norun }
+
+unit tw10540;
+{$mode objfpc}{$H+}
+
+interface
+
+function s(l: PChar; r: PPChar; rn: PInteger; var np: Integer; ll: Integer):Integer;
+
+function x(M: PChar; N1, N2, L: PInteger; len: Integer): Integer;
+
+implementation
+
+uses Math;
+
+function s(l: PChar; r: PPChar; rn: PInteger; var np: Integer; ll: Integer):Integer;
+begin
+end;
+
+function x(M: PChar; N1, N2, L: PInteger; len: Integer): Integer;
+begin
+end;
+
+end.
+