瀏覽代碼

--- Merging r40529 into '.':
U rtl/objpas/sysutils/sysstr.inc
U rtl/objpas/sysutils/sysstrh.inc
--- Recording mergeinfo for merge of r40529 into '.':
U .
--- Merging r40548 into '.':
U rtl/unix/unix.pp
--- Recording mergeinfo for merge of r40548 into '.':
G .
--- Merging r40803 into '.':
U utils/ptopu.pp
--- Recording mergeinfo for merge of r40803 into '.':
G .
--- Merging r40818 into '.':
U packages/openssl/src/openssl.pas
--- Recording mergeinfo for merge of r40818 into '.':
G .
--- Merging r40838 into '.':
G packages/openssl/src/openssl.pas
--- Recording mergeinfo for merge of r40838 into '.':
G .
--- Merging r40841 into '.':
U packages/fcl-res/src/coffwriter.pp
--- Recording mergeinfo for merge of r40841 into '.':
G .
--- Merging r40908 into '.':
U rtl/inc/getopts.pp
--- Recording mergeinfo for merge of r40908 into '.':
G .
--- Merging r41085 into '.':
U rtl/objpas/sysutils/syswide.inc
U rtl/objpas/sysutils/syswideh.inc
--- Recording mergeinfo for merge of r41085 into '.':
G .
--- Merging r41263 into '.':
U packages/rtl-objpas/src/inc/strutils.pp
--- Recording mergeinfo for merge of r41263 into '.':
G .
--- Merging r41331 into '.':
U rtl/objpas/classes/parser.inc
--- Recording mergeinfo for merge of r41331 into '.':
G .
--- Merging r41332 into '.':
U packages/fcl-xml/src/xmlconf.pp
--- Recording mergeinfo for merge of r41332 into '.':
G .

# revisions: 40529,40548,40803,40818,40838,40841,40908,41085,41263,41331,41332
r40529 | michael | 2018-12-12 09:29:24 +0100 (Wed, 12 Dec 2018) | 1 line
Changed paths:
M /trunk/rtl/objpas/sysutils/sysstr.inc
M /trunk/rtl/objpas/sysutils/sysstrh.inc

Added overloads UintToStr for Delphi compatbibility (bug ID 0034690)
r40548 | michael | 2018-12-14 11:00:44 +0100 (Fri, 14 Dec 2018) | 1 line
Changed paths:
M /trunk/rtl/unix/unix.pp

* Fix bug #0034499
r40803 | michael | 2019-01-08 04:55:32 +0100 (Tue, 08 Jan 2019) | 1 line
Changed paths:
M /trunk/utils/ptopu.pp

* Applied patch by Bart Broersma to fix bug ID #34277
r40818 | michael | 2019-01-09 16:04:04 +0100 (Wed, 09 Jan 2019) | 1 line
Changed paths:
M /trunk/packages/openssl/src/openssl.pas

* Add PEM_write_bio_PKCS7, bug ID #0034842
r40838 | michael | 2019-01-10 23:11:33 +0100 (Thu, 10 Jan 2019) | 1 line
Changed paths:
M /trunk/packages/openssl/src/openssl.pas

* Fix stack overflow
r40841 | michael | 2019-01-11 11:53:45 +0100 (Fri, 11 Jan 2019) | 1 line
Changed paths:
M /trunk/packages/fcl-res/src/coffwriter.pp

* Call inherited constructor
r40908 | michael | 2019-01-19 17:35:30 +0100 (Sat, 19 Jan 2019) | 1 line
Changed paths:
M /trunk/rtl/inc/getopts.pp

* Fix bug ID #19842 using patch from Bart Broersma
r41085 | marco | 2019-01-27 15:52:52 +0100 (Sun, 27 Jan 2019) | 2 lines
Changed paths:
M /trunk/rtl/objpas/sysutils/syswide.inc
M /trunk/rtl/objpas/sysutils/syswideh.inc

* unicode version of isleadchar. utf8 still to follow, see #34754
r41263 | marco | 2019-02-09 13:31:15 +0100 (Sat, 09 Feb 2019) | 2 lines
Changed paths:
M /trunk/packages/rtl-objpas/src/inc/strutils.pp

* Patch from Serge Anvarov with missing strutils aliases. Mantis #35047
r41331 | michael | 2019-02-16 09:39:40 +0100 (Sat, 16 Feb 2019) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/parser.inc

Fix bug ID #35086: TParser should reset position (tentative)
r41332 | michael | 2019-02-16 09:50:13 +0100 (Sat, 16 Feb 2019) | 1 line
Changed paths:
M /trunk/packages/fcl-xml/src/xmlconf.pp

* Fix bug ID #34854

git-svn-id: branches/fixes_3_2@41923 -

marco 6 年之前
父節點
當前提交
499df41c28

+ 1 - 0
packages/fcl-res/src/coffwriter.pp

@@ -150,6 +150,7 @@ uses coffconsts;
 
 constructor TCoffStringTable.Create;
   begin
+    inherited create;
     fSize:=4;
     Duplicates:=dupIgnore;
   end;

+ 8 - 2
packages/fcl-xml/src/xmlconf.pp

@@ -166,6 +166,7 @@ Var
 begin
   F:=TFileStream.Create(AFileName,fmOpenread or fmShareDenyWrite);
   try
+    FFileName := '';
     ReadXMLFile(Doc, AFilename);
     FFileName:=AFileName;
   finally
@@ -398,11 +399,14 @@ procedure TXMLConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean
 begin
   if (not ForceReload) and (FFilename = AFilename) then
     exit;
-    
+
   Flush;
   FreeAndNil(Doc);
   if csLoading in ComponentState then
+  begin
+    FFilename := AFilename;
     exit;
+  end;
   if FileExists(AFilename) and not FStartEmpty then
     LoadFromFile(AFilename)
   else if not Assigned(Doc) then
@@ -425,6 +429,8 @@ begin
   if AValue <> FRootName then
   begin
     FRootName := AValue;
+    if not (ComponentState * [csLoading,csDesigning] = []) then
+      Exit;
     Root := Doc.DocumentElement;
     Cfg := Doc.CreateElement(AValue);
     while Assigned(Root.FirstChild) do
@@ -475,7 +481,7 @@ var
 begin
   for I := Length(FPathStack)-1 downto 0 do
     FPathStack[I] := '';
-  FElement := nil;    
+  FElement := nil;
   FPathDirty := False;
   FPathCount := 0;
 end;

+ 14 - 2
packages/openssl/src/openssl.pas

@@ -1282,7 +1282,7 @@ var
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
   function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
   function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
-
+  function PEM_write_bio_PKCS7(bp : PBIO; x : PPKCS7) : cint;
   // BIO Functions - bio.h
   function BioNew(b: PBIO_METHOD): PBIO;
   procedure BioFreeAll(b: PBIO);
@@ -1728,6 +1728,7 @@ type
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
   TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
   TPEM_write_bio_X509 = function(bp: pBIO; x: PX509): integer; cdecl;
+  TPEM_write_bio_PKCS7 = function(bp: pBIO; x: PPKCS7): integer; cdecl;
 
   // BIO Functions
 
@@ -1963,6 +1964,7 @@ var
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
   _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
   _PEM_write_bio_X509: TPEM_write_bio_X509 = nil;
+  _PEM_write_bio_PKCS7 : TPEM_write_bio_PKCS7 = Nil;
   // BIO Functions
 
   _BIO_ctrl: TBIO_ctrl = nil;
@@ -3677,6 +3679,15 @@ begin
     Result := 0;
 end;
 
+function PEM_write_bio_PKCS7(bp : PBIO; x : PPKCS7) : cint;
+
+begin
+  if InitSSLInterface and Assigned(_PEM_write_bio_PKCS7) then
+    Result := _PEM_write_bio_PKCS7(bp, x)
+  else
+    Result := 0;
+end;
+
 
 // BIO Functions
 
@@ -4869,7 +4880,7 @@ begin
   _PEM_write_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PUBKEY');
   _PEM_read_bio_X509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509');
   _PEM_write_bio_X509 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_X509');
-
+  _PEM_write_bio_PKCS7 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_PKCS7');
   // BIO
   _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl');
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
@@ -5333,6 +5344,7 @@ begin
   _PEM_write_bio_PrivateKey := nil;
   _PEM_read_bio_X509 := nil;
   _PEM_write_bio_X509 := nil;
+  _PEM_write_bio_PKCS7 := nil;
 
   // BIO
 

+ 56 - 3
packages/rtl-objpas/src/inc/strutils.pp

@@ -20,7 +20,7 @@ unit StrUtils;
 interface
 
 uses
-  SysUtils{, Types};
+  SysUtils, Types;
 
 { ---------------------------------------------------------------------
     Case insensitive search/replace
@@ -36,6 +36,11 @@ Function AnsiIndexText(const AText: string; const AValues: array of string): Int
 Function StartsText(const ASubText, AText: string): Boolean; inline;
 Function EndsText(const ASubText, AText: string): Boolean; inline;
 
+function ResemblesText(const AText, AOther: string): Boolean; inline;
+function ContainsText(const AText, ASubText: string): Boolean; inline;
+function MatchText(const AText: string; const AValues: array of string): Boolean; inline;
+function IndexText(const AText: string; const AValues: array of string): Integer; inline;
+
 { ---------------------------------------------------------------------
     Case sensitive search/replace
   ---------------------------------------------------------------------}
@@ -54,6 +59,11 @@ Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeStr
 Function IndexText(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
 Operator in (const AText: string; const AValues: array of string):Boolean;inline;
 Operator in (const AText: UnicodeString; const AValues: array of UnicodeString):Boolean;inline;
+
+function ContainsStr(const AText, ASubText: string): Boolean; inline;
+function MatchStr(const AText: string; const AValues: array of string): Boolean; inline;
+function IndexStr(const AText: string; const AValues: array of string): Integer; inline;
+
 { ---------------------------------------------------------------------
     Miscellaneous
   ---------------------------------------------------------------------}
@@ -67,6 +77,8 @@ Function IfThen(AValue: Boolean; const ATrue: string; const AFalse: string = '')
 function NaturalCompareText (const S1 , S2 : string ): Integer ;
 function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThousandSeparator: Char): Integer;
 
+function SplitString(const S, Delimiters: string): TStringDynArray;
+
 { ---------------------------------------------------------------------
     VB emulations.
   ---------------------------------------------------------------------}
@@ -146,6 +158,7 @@ type
 
 Const
   AnsiResemblesProc: TCompareTextProc = @SoundexProc;
+  ResemblesProc: TCompareTextProc = @SoundexProc;
 
 { ---------------------------------------------------------------------
     Other functions, based on RxStrUtils.
@@ -927,19 +940,54 @@ begin
   Result := AnsiEndsText(ASubText, AText);
 end;
 
+function ResemblesText(const AText, AOther: string): Boolean;
+begin
+  if Assigned(ResemblesProc) then
+    Result := ResemblesProc(AText, AOther)
+  else
+    Result := False;
+end;
+
+function ContainsText(const AText, ASubText: string): Boolean;
+begin
+  Result := AnsiContainsText(AText, ASubText);
+end;
+
+function MatchText(const AText: string; const AValues: array of string): Boolean;
+begin
+  Result := AnsiMatchText(AText, AValues);
+end;
+
+function IndexText(const AText: string; const AValues: array of string): Integer;
+begin
+  Result := AnsiIndexText(AText, AValues);
+end;
+
+function ContainsStr(const AText, ASubText: string): Boolean;
+begin
+  Result := AnsiContainsStr(AText, ASubText);
+end;
+
+function MatchStr(const AText: string; const AValues: array of string): Boolean;
+begin
+  Result := AnsiMatchStr(AText, AValues);
+end;
+
+function IndexStr(const AText: string; const AValues: array of string): Integer;
+begin
+  Result := AnsiIndexStr(AText, AValues);
+end;
 
 function AnsiReplaceText(const AText, AFromText, AToText: string): string;
 begin
   Result := StringReplace(AText,AFromText,AToText,[rfReplaceAll,rfIgnoreCase]);
 end;
 
-
 function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;
 begin
   Result:=(AnsiIndexText(AText,AValues)<>-1)
 end;
 
-
 function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
 begin
   for Result := Low(AValues) to High(AValues) do
@@ -1292,6 +1340,11 @@ begin
   end;
 end;
 
+function SplitString(const S, Delimiters: string): TStringDynArray;
+begin
+  Result := S.Split(Delimiters);
+end;
+
 function NaturalCompareText (const S1 , S2 : string ): Integer ;
 begin
   Result := NaturalCompareText(S1, S2,

+ 10 - 22
rtl/inc/getopts.pp

@@ -47,27 +47,24 @@ Function GetLongOpts (ShortOpts : String;LongOpts : POption;var Longind : Longin
 
 
 Implementation
-{$IFNDEF FPC}
-  {$ifdef TP}
-    uses strings;
-  {$else }
-    uses SysUtils;
-    type PtrInt = Integer;
-  {$endif}
-{$ENDIF FPC}
 
+{$IFNDEF FPC}
 {***************************************************************************
                                Create an ArgV
 ***************************************************************************}
 
-{$IF not Declared(argv)} //{$ifdef TP}
+uses SysUtils;
+
+    type PtrInt = Integer;
 
 type
   ppchar = ^pchar;
   apchar = array[0..127] of pchar;
+
 var
   argc  : longint;
   argv  : apchar;
+
 const
   CHAR_SIZE = SizeOf(Char);
 
@@ -139,7 +136,7 @@ begin
   move(argsbuf,argv,count shl 2);
 end;
 
-{$IFEND} //{$endif TP}
+{$ENDIF}
 
 {***************************************************************************
                                Real Getopts
@@ -167,7 +164,7 @@ begin
     if (top-middle>middle-bottom) then
       begin
       len:=middle-bottom;
-      for i:=1 to len-1 do
+      for i:=0 to len-1 do
         begin
         temp:=argv[bottom+i];
         argv[bottom+i]:=argv[top-(middle-bottom)+i];
@@ -496,17 +493,8 @@ begin
   getlongopts:=internal_getopt(shortopts,longopts,@longind,true);
 end;
 
-{$ifdef FPC}
-    initialization
-{$endif}
-{$ifndef FPC}
-  {$ifdef TP}
-    begin
-  {$else}
-    initialization
-  {$endif}
-{$endif}
-{ create argv if running under TP }
+initialization
+{ create argv if not running under FPC }
 {$ifndef FPC}
   setup_arguments;
 {$endif}

+ 9 - 1
rtl/objpas/classes/parser.inc

@@ -361,8 +361,16 @@ begin
 end;
 
 destructor TParser.Destroy;
+
+Var
+  aCount : Integer;
+
 begin
-  fStream.Position:=SourcePos;
+  if fToken=toWString then
+    aCount:=Length(fLastTokenWStr)*2
+  else
+    aCount:=Length(fLastTokenStr);
+  fStream.Position:=SourcePos-aCount;
   FreeMem(fBuf);
 end;
 

+ 11 - 0
rtl/objpas/sysutils/sysstr.inc

@@ -850,6 +850,17 @@ begin
  System.Str(Value, result);
 end ;
 
+function UIntToStr(Value: QWord): string;
+
+begin
+  result:=IntTostr(Value);
+end;
+
+function UIntToStr(Value: Cardinal): string; 
+
+begin
+  System.Str(Value, result);
+end;
 
 {   IntToHex returns a string representing the hexadecimal value of Value   }
 

+ 2 - 0
rtl/objpas/sysutils/sysstrh.inc

@@ -115,6 +115,8 @@ function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDot
 function IntToStr(Value: Longint): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: Int64): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: Cardinal): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToHex(Value: Longint; Digits: integer): string;
 function IntToHex(Value: Int64; Digits: integer): string;
 function IntToHex(Value: QWord; Digits: integer): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}

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

@@ -11,6 +11,11 @@
     *********************************************************************
 }
 
+function IsLeadChar(Ch: WideChar): Boolean;
+begin
+    Result := (Ch >= #$D800) and (Ch <= #$DFFF);
+end;
+
 function Trim(const S: widestring): widestring;
 	var 
 	  Ofs, Len: sizeint;
@@ -180,6 +185,7 @@ begin
   result:=(Ch<=#$FF) and (ansichar(byte(ch)) in CSet);
 end;
 
+
 {$macro on}
 {$define INWIDESTRINGREPLACE}
 {$define SRString:=WideString}

+ 3 - 0
rtl/objpas/sysutils/syswideh.inc

@@ -35,3 +35,6 @@ function StrCopy(Dest, Source: PWideChar): PWideChar; overload;
 function StrLCopy(Dest,Source: PWideChar; MaxLen: SizeInt): PWideChar; overload;
 Function CharInSet(Ch:WideChar;Const CSet : TSysCharSet) : Boolean;
 function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags): WideString;
+
+function IsLeadChar(Ch: WideChar): Boolean; inline; overload;
+

+ 4 - 1
rtl/unix/unix.pp

@@ -914,6 +914,8 @@ var
   pl   : ^cint;
 begin
   AssignStream:=-1;
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   if AssignPipe(streamin,pipo)=-1 Then
    exit(-1);
   if AssignPipe(pipi,streamout)=-1 Then
@@ -985,7 +987,8 @@ var
   pl: ^cint;
 begin
   AssignStream := -1;
-
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   // Assign pipes
   if AssignPipe(StreamIn, PipeOut)=-1 Then
    Exit(-1);

+ 4 - 4
utils/ptopu.pp

@@ -72,7 +72,7 @@ TYPE
                notsym,nilsym,orsym,setsym,tosym,virtualsym,usessym,
                casevarsym,ofobjectsym,
                { other symbols }
-               becomes,delphicomment,dopencomment,dclosecomment,opencomment,closecomment,semicolon,colon,equals,
+               becomes,notequal,lessorequal,greaterorequal,delphicomment,dopencomment,dclosecomment,opencomment,closecomment,semicolon,colon,equals,
                openparen,closeparen,period,endoffile,othersym);
 
   { Formatting options }
@@ -252,7 +252,7 @@ CONST
                'and','arr','div','down','file','goto',
                'in','mod','not','nil','or','set','to','virtual','uses',
                'casevar','ofobject',
-               'becomes','delphicomment','dopencomment','dclosecomment',
+               'becomes','notequal','lessorequal','greaterorequal','delphicomment','dopencomment','dclosecomment',
                'opencomment','closecomment','semicolon',
                'colon','equals',
                'openparen','closeparen','period','endoffile','other');
@@ -265,7 +265,7 @@ CONST
 
 
   DblChar : DblCharTable =
-     ( ':=', '//','(*','*)' );
+     ( ':=', '<>', '<=', '>=',  '//','(*','*)' );
 
   SglChar : SglCharTable =
     ('{', '}', ';', ':', '=', '(', ')', '.' );
@@ -1411,5 +1411,5 @@ End;
 
 
 Begin
-  dblch := [becomes, opencomment];
+  dblch := [becomes, notequal, lessorequal, greaterorequal, opencomment];
 end.