Prechádzať zdrojové kódy

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 rokov pred
rodič
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/tw1050.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/tw1066a.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);
     destructor Destroy; 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;
   end;
@@ -81,7 +80,6 @@ type
     procedure Reset;
 
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     
     property EOF: Boolean read fEOF;
@@ -158,11 +156,6 @@ begin
   inherited Destroy;
 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;
 var
   ReadNow: LongInt;
@@ -413,11 +406,6 @@ begin
   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;
 begin
   // TODO: implement Seeking in TBase64DecodingStream

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

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

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

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

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

@@ -85,7 +85,6 @@ Type
   TIDEAEncryptStream = Class(TIDEAStream)
   public
     Destructor Destroy; 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;
     procedure Flush;
@@ -94,7 +93,6 @@ Type
   TIDEADeCryptStream = Class(TIDEAStream)
   public
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
   end;
 
@@ -102,8 +100,6 @@ Implementation
 
 Const
   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);
 VAR p: LongInt;
@@ -288,12 +284,6 @@ begin
     end;
 end;
 
-function TIDEAEncryptStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Raise EIDEAError.Create(SNoReadAllowed);
-end;
-
 function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint;
 
 Var
@@ -382,11 +372,6 @@ begin
   Inc(FPos,Result);
 end;
 
-function TIDEADeCryptStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  Raise EIDEAError.Create(SNoWriteAllowed);
-end;
-
 function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 
 Var Buffer : Array[0..1023] of byte;

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

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

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

@@ -14,6 +14,29 @@
 {*                             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;
 
     begin
@@ -340,7 +363,7 @@
      end;
    end;
 
-  Procedure TStream.WriteAnsiString (S : String);
+  Procedure TStream.WriteAnsiString (const S : String);
 
   Var L : Longint;
 
@@ -771,13 +794,6 @@ destructor TResourceStream.Destroy;
     inherited destroy;
   end;
 
-{$warnings off}
-function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-  begin
-    raise EStreamError.Create(SCantWriteResourceStreamError);
-  end;
-{$warnings on}
-
 {****************************************************************************}
 {*                             TOwnerStream                                 *}
 {****************************************************************************}

+ 29 - 15
rtl/objpas/dateutil.inc

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

+ 1 - 1
rtl/objpas/math.pp

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

+ 2 - 0
rtl/objpas/rtlconst.inc

@@ -248,6 +248,8 @@ ResourceString
   SSocketRead                   = 'Read';
   SSocketWrite                  = 'Write';
   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';
   SStringExpected               = 'String expected';
   SSymbolExpected               = '%s expected';

+ 1 - 1
rtl/objpas/strutils.pp

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

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

@@ -34,8 +34,14 @@ const
    SecsPerDay  = MinsPerDay * SecsPerMin;
    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
-   UnixDateDelta = 25569;
+   UnixDateDelta = Trunc(UnixEpoch); //25569
+
 
    { True=Leapyear }
    MonthDays: array [Boolean] of TDayTable =

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

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

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

@@ -221,11 +221,21 @@ begin
  Result:=CompareText(S1,S2)=0;
 end;
 
+{$ifndef FPC_NOGENERICANSIROUTINES}
 {==============================================================================}
 {   Ansi string functions                                                      }
 {   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;
   var
     len, i: integer;
@@ -282,18 +292,6 @@ begin
     Result:=L1-L2;
 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;
 
 begin
@@ -423,6 +421,19 @@ if Str <> Nil then begin
       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;
 
@@ -2601,12 +2612,13 @@ begin
 end;
 
 
+{$ifndef FPC_NOGENERICANSIROUTINES}
 {
    Case Translation Tables
    Can be used in internationalization support.
 
    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:
    before modifying a translation table make sure that the current codepage
    of the OS corresponds to the one you make changes to
@@ -2659,6 +2671,7 @@ const
      #240, #241, #242, #243, #244, #245, #246, #247,
      #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;
   var

+ 0 - 24
rtl/win/sysutils.pp

@@ -613,29 +613,6 @@ end;
                               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;
 var
   L: Integer;
@@ -732,7 +709,6 @@ begin
   // probably needs update with getthreadlocale. post 2.0.2
 
   Set8087CW(old8087CW);
-  InitAnsi;
   GetFormatSettings;
 end;
 

+ 0 - 24
rtl/wince/sysutils.pp

@@ -485,29 +485,6 @@ end;
                               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;
 var
   L: Integer;
@@ -614,7 +591,6 @@ begin
   InitInternationalGeneric;
   SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
   SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
-  InitAnsi;
   GetFormatSettings;
 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.
+