From 93ebf5468fc2cf984d8884414be573f7ee02247b Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 13 Jul 2019 13:33:31 +0000 Subject: [PATCH] * Merging revisions r42153,r42168,r42170,r42171,r42172,r42173,r42174 from trunk: ------------------------------------------------------------------------ r42153 | michael | 2019-06-01 11:42:27 +0200 (Sat, 01 Jun 2019) | 1 line * Fix bug #35660, introduce prefervaluestonames ------------------------------------------------------------------------ r42168 | michael | 2019-06-03 08:27:37 +0200 (Mon, 03 Jun 2019) | 1 line * Changed String.Split to conform to behaviour in Delphi Rio (bug ID 35669) ------------------------------------------------------------------------ r42170 | michael | 2019-06-04 09:00:48 +0200 (Tue, 04 Jun 2019) | 1 line * Better fix for 35660: Introduced TMissingNameValueSeparatorAction ------------------------------------------------------------------------ r42171 | michael | 2019-06-04 09:08:45 +0200 (Tue, 04 Jun 2019) | 1 line * Sort public properties/methods in stringlist ------------------------------------------------------------------------ r42172 | michael | 2019-06-04 09:29:53 +0200 (Tue, 04 Jun 2019) | 1 line * Added constant for new error message in stringlist ------------------------------------------------------------------------ r42173 | michael | 2019-06-04 10:31:39 +0200 (Tue, 04 Jun 2019) | 1 line Fix bug ID #0035672 ------------------------------------------------------------------------ r42174 | michael | 2019-06-05 13:42:40 +0200 (Wed, 05 Jun 2019) | 1 line * Fix bug ID #35674, do not create filestream for directories ------------------------------------------------------------------------ git-svn-id: branches/fixes_3_2@42429 - --- packages/paszlib/src/zipper.pp | 5 ++-- packages/winunits-base/src/imm.pas | 2 +- rtl/objpas/classes/classesh.inc | 43 +++++++++++++++++------------- rtl/objpas/classes/stringl.inc | 27 ++++++++++++++++++- rtl/objpas/rtlconst.inc | 1 + rtl/objpas/sysutils/syshelp.inc | 24 ++++++++--------- 6 files changed, 67 insertions(+), 35 deletions(-) diff --git a/packages/paszlib/src/zipper.pp b/packages/paszlib/src/zipper.pp index 985204be04..10318eb612 100644 --- a/packages/paszlib/src/zipper.pp +++ b/packages/paszlib/src/zipper.pp @@ -2147,7 +2147,7 @@ Begin If Assigned(FOnCreateStream) then FOnCreateStream(Self, OutStream, Item); // If FOnCreateStream didn't create one, we create one now. - If (OutStream=Nil) then + If (OutStream=Nil) and (not Item.IsDirectory) then begin if (Path<>'') then ForceDirectories(Path); @@ -2173,7 +2173,8 @@ Begin OutStream := nil; end else - FreeAndNil(OutStream); + if Assigned(OutStream) then + FreeAndNil(OutStream); DoEndOfFile; end; diff --git a/packages/winunits-base/src/imm.pas b/packages/winunits-base/src/imm.pas index 9f667ac198..cb391c5775 100644 --- a/packages/winunits-base/src/imm.pas +++ b/packages/winunits-base/src/imm.pas @@ -434,7 +434,7 @@ function ImmGetStatusWindowPos(imc: HIMC; lpptPos: LPPOINT): LongBool; stdcall ; function ImmSetStatusWindowPos(imc: HIMC; lpptPos: LPPOINT): LongBool; stdcall ; external Imm name 'ImmSetStatusWindowPos'; function ImmGetCompositionWindow(imc: HIMC; lpCompForm: LPCOMPOSITIONFORM): LongBool; stdcall ; external Imm name 'ImmGetCompositionWindow'; function ImmSetCompositionWindow(imc: HIMC; lpCompForm: LPCOMPOSITIONFORM): LongBool; stdcall ; external Imm name 'ImmSetCompositionWindow'; -function ImmGetCandidateWindow(imc: HIMC; par1: DWORD; lpCandidate: LPCANDIDATEFORM): LongBool; stdcall ; external Imm name 'ImmGetCandidateWindow('; +function ImmGetCandidateWindow(imc: HIMC; par1: DWORD; lpCandidate: LPCANDIDATEFORM): LongBool; stdcall ; external Imm name 'ImmGetCandidateWindow'; function ImmSetCandidateWindow(imc: HIMC; lpCandidate: LPCANDIDATEFORM): LongBool; stdcall ; external Imm name 'ImmSetCandidateWindow'; function ImmIsUIMessageA(wnd: HWND; msg: UINT; wPar: WPARAM; lPar: LPARAM): LongBool; stdcall ; external Imm name 'ImmIsUIMessageA'; diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index 88bd140a5b..f4e6c28960 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -598,11 +598,14 @@ type end; { TStrings class } + TMissingNameValueSeparatorAction = (mnvaValue,mnvaName,mnvaEmpty,mnvaError); + TMissingNameValueSeparatorActions = set of TMissingNameValueSeparatorAction; TStrings = class(TPersistent) private FDefaultEncoding: TEncoding; FEncoding: TEncoding; + FMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction; FSpecialCharsInited : boolean; FAlwaysQuote: Boolean; FQuoteChar : Char; @@ -616,6 +619,7 @@ type FLineBreak : String; FWriteBOM: Boolean; function GetCommaText: string; + function GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction; function GetName(Index: Integer): string; function GetValue(const Name: string): string; Function GetLBS : TTextLineBreakStyle; @@ -624,6 +628,7 @@ type Procedure SetLBS (AValue : TTextLineBreakStyle); procedure ReadData(Reader: TReader); procedure SetCommaText(const Value: string); + procedure SetMissingNameValueSeparatorAction(AValue: TMissingNameValueSeparatorAction); procedure SetStringsAdapter(const Value: IStringsAdapter); procedure SetValue(const Name, Value: string); procedure SetDelimiter(c:Char); @@ -674,12 +679,12 @@ type function AddObject(const Fmt: string; Args : Array of const; AObject: TObject): Integer; overload; function AddPair(const AName, AValue: string): TStrings; overload; {$IFDEF CLASSESINLINE}inline;{$ENDIF} function AddPair(const AName, AValue: string; AObject: TObject): TStrings; overload; - procedure Append(const S: string); procedure AddStrings(TheStrings: TStrings); overload; virtual; procedure AddStrings(TheStrings: TStrings; ClearFirst : Boolean); overload; procedure AddStrings(const TheStrings: array of string); overload; virtual; procedure AddStrings(const TheStrings: array of string; ClearFirst : Boolean); overload; Procedure AddText(Const S : String); virtual; + procedure Append(const S: string); procedure Assign(Source: TPersistent); override; procedure BeginUpdate; procedure Clear; virtual; abstract; @@ -688,14 +693,15 @@ type function Equals(Obj: TObject): Boolean; override; overload; function Equals(TheStrings: TStrings): Boolean; overload; procedure Exchange(Index1, Index2: Integer); virtual; + function ExtractName(Const S:String):String; function GetEnumerator: TStringsEnumerator; + procedure GetNameValue(Index : Integer; Out AName,AValue : String); function GetText: PChar; virtual; function IndexOf(const S: string): Integer; virtual; function IndexOfName(const Name: string): Integer; virtual; function IndexOfObject(AObject: TObject): Integer; virtual; procedure Insert(Index: Integer; const S: string); virtual; abstract; - procedure InsertObject(Index: Integer; const S: string; - AObject: TObject); + procedure InsertObject(Index: Integer; const S: string; AObject: TObject); procedure LoadFromFile(const FileName: string); overload; virtual; procedure LoadFromFile(const FileName: string; IgnoreEncoding : Boolean); procedure LoadFromFile(const FileName: string; AEncoding: TEncoding); overload; virtual; @@ -708,29 +714,28 @@ type procedure SaveToStream(Stream: TStream); overload; virtual; procedure SaveToStream(Stream: TStream; AEncoding: TEncoding); overload; virtual; procedure SetText(TheText: PChar); virtual; - procedure GetNameValue(Index : Integer; Out AName,AValue : String); - function ExtractName(Const S:String):String; - Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS; - property Delimiter: Char read GetDelimiter write SetDelimiter; - property DelimitedText: string read GetDelimitedText write SetDelimitedText; - property DefaultEncoding: TEncoding read FDefaultEncoding write SetDefaultEncoding; - property Encoding: TEncoding read FEncoding; - property LineBreak : string Read GetLineBreak write SetLineBreak; - Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter; property AlwaysQuote: Boolean read FAlwaysQuote write FAlwaysQuote; - property QuoteChar: Char read GetQuoteChar write SetQuoteChar; - Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator; - property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; property Capacity: Integer read GetCapacity write SetCapacity; property CommaText: string read GetCommaText write SetCommaText; property Count: Integer read GetCount; + property DefaultEncoding: TEncoding read FDefaultEncoding write SetDefaultEncoding; + property DelimitedText: string read GetDelimitedText write SetDelimitedText; + property Delimiter: Char read GetDelimiter write SetDelimiter; + property Encoding: TEncoding read FEncoding; + property LineBreak : string Read GetLineBreak write SetLineBreak; + Property MissingNameValueSeparatorAction : TMissingNameValueSeparatorAction Read GetMissingNameValueSeparatorAction Write SetMissingNameValueSeparatorAction; property Names[Index: Integer]: string read GetName; + Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator; property Objects[Index: Integer]: TObject read GetObject write PutObject; - property Values[const Name: string]: string read GetValue write SetValue; - property Strings[Index: Integer]: string read Get write Put; default; - property Text: string read GetTextStr write SetTextStr; - property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter; + property QuoteChar: Char read GetQuoteChar write SetQuoteChar; Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak; + Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter; + property Strings[Index: Integer]: string read Get write Put; default; + property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter; + property Text: string read GetTextStr write SetTextStr; + Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS; + property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; + property Values[const Name: string]: string read GetValue write SetValue; property WriteBOM: Boolean read FWriteBOM write FWriteBOM; end; diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc index b3708645bc..db25a75262 100644 --- a/rtl/objpas/classes/stringl.inc +++ b/rtl/objpas/classes/stringl.inc @@ -162,6 +162,7 @@ begin FNameValueSeparator:=c; end; + Function TStrings.GetNameValueSeparator :Char; begin CheckSpecialChars; @@ -192,6 +193,12 @@ begin end; end; +function TStrings.GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction; +begin + CheckSpecialChars; + Result:=FMissingNameValueSeparatorAction; +end; + Function TStrings.GetDelimitedText: string; @@ -240,6 +247,7 @@ procedure TStrings.GetNameValue(Index : Integer; Out AName,AValue : String); Var L : longint; begin + aName:=''; CheckSpecialChars; AValue:=Strings[Index]; L:=Pos(FNameValueSeparator,AValue); @@ -249,7 +257,18 @@ begin System.Delete(AValue,1,L); end else - AName:=''; + case FMissingNameValueSeparatorAction of + mnvaValue : ; + mnvaName : + begin + aName:=aValue; + aValue:=''; + end; + mnvaEmpty : + aValue:=''; + mnvaError : + Raise EStringListError.CreateFmt(SErrNoNameValuePairAt,[Index]); + end; end; function TStrings.ExtractName(const s:String):String; @@ -445,6 +464,12 @@ begin end; end; +procedure TStrings.SetMissingNameValueSeparatorAction(AValue: TMissingNameValueSeparatorAction); +begin + CheckSpecialChars; + FMissingNameValueSeparatorAction:=aValue; +end; + Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter); diff --git a/rtl/objpas/rtlconst.inc b/rtl/objpas/rtlconst.inc index 9132b16550..c26a7d90d9 100644 --- a/rtl/objpas/rtlconst.inc +++ b/rtl/objpas/rtlconst.inc @@ -308,6 +308,7 @@ ResourceString SParamIsNegative = 'Parameter "%s" cannot be negative.'; SErrCannotWriteToProperty = 'Cannot write to property "%s".'; SErrCannotReadProperty = 'Cannot read property "%s".'; + SErrNoNameValuePairAt = 'No name=value pair at position %d.'; { --------------------------------------------------------------------- Keysim Names diff --git a/rtl/objpas/sysutils/syshelp.inc b/rtl/objpas/sysutils/syshelp.inc index afdd2dd886..07c29f3813 100644 --- a/rtl/objpas/sysutils/syshelp.inc +++ b/rtl/objpas/sysutils/syshelp.inc @@ -1097,34 +1097,34 @@ end; function TStringHelper.Split(const Separators: array of Char): TStringArray; begin - Result:=SPlit(Separators,#0,#0,Length,TStringSplitOptions.None); + Result:=Split(Separators,#0,#0,Length+1,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt ): TStringArray; begin - Result:=SPlit(Separators,#0,#0,ACount,TStringSplitOptions.None); + Result:=Split(Separators,#0,#0,ACount,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of Char; Options: TStringSplitOptions): TStringArray; begin - Result:=SPlit(Separators,Length,Options); + Result:=Split(Separators,Length+1,Options); end; function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; begin - Result:=SPlit(Separators,#0,#0,ACount,Options); + Result:=Split(Separators,#0,#0,ACount,Options); end; function TStringHelper.Split(const Separators: array of string): TStringArray; begin - Result:=Split(Separators,Length); + Result:=Split(Separators,Length+1); end; @@ -1138,7 +1138,7 @@ end; function TStringHelper.Split(const Separators: array of string; Options: TStringSplitOptions): TStringArray; begin - Result:=Split(Separators,Length,Options); + Result:=Split(Separators,Length+1,Options); end; @@ -1166,7 +1166,7 @@ end; function TStringHelper.Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; begin - Result:=Split(Separators,AQuoteStart,AQuoteEnd,Length,Options); + Result:=Split(Separators,AQuoteStart,AQuoteEnd,Length+1,Options); end; @@ -1211,7 +1211,7 @@ begin While (Sep<>-1) and ((ACount=0) or (Len',T,'< at pos,',LastSep,' till pos ',Sep); +// Writeln('Examining >',T,'< at pos ',LastSep,', till pos ',Sep); If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then begin MaybeGrow(Len); @@ -1221,7 +1221,7 @@ begin LastSep:=Sep+1; Sep:=NextSep(LastSep); end; - if (LastSep',T,'< at pos,',LastSep,' till pos ',Sep); @@ -1243,14 +1243,14 @@ end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char): TStringArray; begin - Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length,TStringSplitOptions.None); + Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; begin - Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length,Options); + Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,Options); end; @@ -1304,7 +1304,7 @@ begin LastSep:=Sep+System.Length(Separators[Match]); Sep:=NextSep(LastSep,Match); end; - if (LastSep',T,'< at pos,',LastSep,' till pos ',Sep);