diff options
Diffstat (limited to 'rtl/objpas')
| -rw-r--r-- | rtl/objpas/classes/classesh.inc | 19 | ||||
| -rw-r--r-- | rtl/objpas/classes/streams.inc | 26 | ||||
| -rw-r--r-- | rtl/objpas/classes/stringl.inc | 20 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/dati.inc | 16 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/filutil.inc | 6 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/filutilh.inc | 13 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/fina.inc | 11 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/sysstr.inc | 24 | ||||
| -rw-r--r-- | rtl/objpas/sysutils/sysutils.inc | 4 | ||||
| -rw-r--r-- | rtl/objpas/types.pp | 12 | ||||
| -rw-r--r-- | rtl/objpas/unicodedata.pas | 9 |
11 files changed, 105 insertions, 55 deletions
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index 60669bb9fb..adb906bca7 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -623,6 +623,9 @@ type procedure SetNameValueSeparator(c:Char); procedure WriteData(Writer: TWriter); procedure DoSetTextStr(const Value: string; DoClear : Boolean); + Function GetDelimiter : Char; + Function GetNameValueSeparator : Char; + Function GetQuoteChar: Char; protected procedure DefineProperties(Filer: TFiler); override; procedure Error(const Msg: string; Data: Integer); @@ -677,11 +680,11 @@ type 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 FDelimiter write SetDelimiter; + property Delimiter: Char read GetDelimiter write SetDelimiter; property DelimitedText: string read GetDelimitedText write SetDelimitedText; Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter; - property QuoteChar: Char read FQuoteChar write SetQuoteChar; - Property NameValueSeparator : Char Read FNameValueSeparator Write SetNameValueSeparator; + 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; @@ -1606,9 +1609,8 @@ type {$ifdef Unix} private // see tthread.inc, ThreadFunc and TThread.Resume - FSem: Pointer; + FSuspendEvent: PRTLEvent; FInitialSuspended: boolean; - FSuspendedExternal: boolean; FSuspendedInternal: longbool; FThreadReaped: boolean; {$endif} @@ -1620,6 +1622,13 @@ type FSuspendedExternal: boolean; FPid: LongInt; {$endif} +{$ifdef aros} + private + // see tthread.inc, ThreadFunc and TThread.Resume + FSem: Pointer; + FCond: Pointer; + FInitialSuspended: boolean; +{$endif} public constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize); diff --git a/rtl/objpas/classes/streams.inc b/rtl/objpas/classes/streams.inc index 63e5895aee..e6594d6e00 100644 --- a/rtl/objpas/classes/streams.inc +++ b/rtl/objpas/classes/streams.inc @@ -184,15 +184,31 @@ end; procedure TStream.ReadBuffer(var Buffer; Count: Longint); - begin - if Read(Buffer,Count)<Count then - Raise EReadError.Create(SReadError); - end; + Var + r,t : longint; + + begin + t:=0; + repeat + r:=Read(PByte(@Buffer)[t],Count); + inc(t,r); + until (t=Count) or (r=0); + if (t<Count) then + Raise EReadError.Create(SReadError); + end; procedure TStream.WriteBuffer(const Buffer; Count: Longint); + var + r,t : Longint; + begin - if Write(Buffer,Count)<Count then + T:=0; + Repeat + r:=Write(PByte(@Buffer)[t],Count); + inc(t,r); + Until (t=count) or (r=0); + if (t<Count) then Raise EWriteError.Create(SWriteError); end; diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc index afc84f49a7..7f274c7702 100644 --- a/rtl/objpas/classes/stringl.inc +++ b/rtl/objpas/classes/stringl.inc @@ -74,8 +74,8 @@ begin FQuoteChar:='"'; FDelimiter:=','; FNameValueSeparator:='='; - FSpecialCharsInited:=true; FLBS:=DefaultTextLineBreakStyle; + FSpecialCharsInited:=true; end; end; @@ -97,6 +97,12 @@ begin FDelimiter:=c; end; +Function TStrings.GetDelimiter : Char; +begin + CheckSpecialChars; + Result:=FDelimiter; +end; + procedure TStrings.SetQuoteChar(c:Char); begin @@ -104,12 +110,24 @@ begin FQuoteChar:=c; end; +Function TStrings.GetQuoteChar :Char; +begin + CheckSpecialChars; + Result:=FQuoteChar; +end; + procedure TStrings.SetNameValueSeparator(c:Char); begin CheckSpecialChars; FNameValueSeparator:=c; end; +Function TStrings.GetNameValueSeparator :Char; +begin + CheckSpecialChars; + Result:=FNameValueSeparator; +end; + function TStrings.GetCommaText: string; diff --git a/rtl/objpas/sysutils/dati.inc b/rtl/objpas/sysutils/dati.inc index 25a8b69567..ef187dfb14 100644 --- a/rtl/objpas/sysutils/dati.inc +++ b/rtl/objpas/sysutils/dati.inc @@ -1380,24 +1380,12 @@ end; function TryStrToDateTime(const S: ShortString; out Value: TDateTime): Boolean; begin - result:=true; - try - value:=StrToDateTime(s); - except - on EConvertError do - result:=false - end; + result := TryStrToDateTime(S, Value, DefaultFormatSettings); end; function TryStrToDateTime(const S: AnsiString; out Value: TDateTime): Boolean; begin - result:=true; - try - value:=StrToDateTime(s); - except - on EConvertError do - result:=false - end; + result := TryStrToDateTime(S, Value, DefaultFormatSettings); end; function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean; diff --git a/rtl/objpas/sysutils/filutil.inc b/rtl/objpas/sysutils/filutil.inc index d9e2607abd..fe3c5522c8 100644 --- a/rtl/objpas/sysutils/filutil.inc +++ b/rtl/objpas/sysutils/filutil.inc @@ -433,11 +433,9 @@ type indication enough that you should not touch it } Name_do_not_touch : RawByteString; ExcludeAttr : Longint; + FindHandle : {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}; {$ifdef unix} - FindHandle : Pointer; Mode : TMode; - {$else unix} - FindHandle : THandle; {$endif unix} {$ifdef USEFINDDATA} FindData : TFindData; @@ -455,7 +453,7 @@ Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint; forward; {$endif SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL} -procedure InternalFindClose(var Handle: {$ifdef unix}Pointer{$else}THandle{$endif}{$ifdef USEFINDDATA};var FindData: TFindData{$endif}); forward; +procedure InternalFindClose(var Handle: {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}{$ifdef USEFINDDATA};var FindData: TFindData{$endif}); forward; {$ifndef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL} diff --git a/rtl/objpas/sysutils/filutilh.inc b/rtl/objpas/sysutils/filutilh.inc index c6453be400..5d57f0799a 100644 --- a/rtl/objpas/sysutils/filutilh.inc +++ b/rtl/objpas/sysutils/filutilh.inc @@ -16,6 +16,11 @@ Type + // Some operating systems need FindHandle to be a Pointer +{$if defined(unix) or defined(msdos)} + {$define FINDHANDLE_IS_POINTER} +{$endif} + // Some operating systems need extra find data. {$if defined(Win32) or defined(WinCE) or defined(Win64)} {$define USEFINDDATA} @@ -45,11 +50,9 @@ Type Attr : Longint; Name : UnicodeString; ExcludeAttr : Longint; + FindHandle : {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}; {$ifdef unix} - FindHandle : Pointer; Mode : TMode; -{$else unix} - FindHandle : THandle; {$endif unix} {$ifdef USEFINDDATA} FindData : TFindData; @@ -62,11 +65,9 @@ Type Attr : Longint; Name : RawByteString; ExcludeAttr : Longint; + FindHandle : {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}; {$ifdef unix} - FindHandle : Pointer; Mode : TMode; -{$else unix} - FindHandle : THandle; {$endif unix} {$IFDEF USEFINDDATA} FindData : TFindData; diff --git a/rtl/objpas/sysutils/fina.inc b/rtl/objpas/sysutils/fina.inc index b42e9cdf81..02d1b92e55 100644 --- a/rtl/objpas/sysutils/fina.inc +++ b/rtl/objpas/sysutils/fina.inc @@ -74,7 +74,7 @@ begin l:=Length(FileName); if (l<2) then exit; -{$IF DEFINED(AMIGA) OR DEFINED(MORPHOS)} +{$IFDEF HASAMIGA} i:=Pos(DriveSeparator,FileName); if (i > 0) then Result:=Copy(FileName,1,i); {$ELSE} @@ -402,7 +402,11 @@ begin Result:=-1; While I<=Length(DirName) do begin - If CharInSet(DirName[i],AllowDirectorySeparators) and + If (CharInSet(DirName[i],AllowDirectorySeparators) + {$ifdef HASAMIGA} + or (DirName[i] = DriveSeparator) + {$endif} + ) and { avoid error in case last char=pathdelim } (length(dirname)>i) then begin @@ -424,6 +428,9 @@ begin Result:=Path; l:=Length(Result); If (L=0) or not CharInSet(Result[l],AllowDirectorySeparators) then +{$ifdef HASAMIGA} + If (L>0) and (Result[l] <> DriveSeparator) then +{$endif} {$ifdef SYSUTILSUNICODE} Result:=Result+DirectorySeparator; {$else SYSUTILSUNICODE} diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc index 4f183440ef..b75f88467f 100644 --- a/rtl/objpas/sysutils/sysstr.inc +++ b/rtl/objpas/sysutils/sysstr.inc @@ -1327,10 +1327,14 @@ Begin { Delete leading spaces } while Result[1] = ' ' do System.Delete(Result, 1, 1); - if Result[1] = '-' then + + if (Result[1]='-') and + { not Nan etc.? } + (Result[3]='.') then Result[3] := DS - else + else if Result[2]='.' then Result[2] := DS; + P:=Pos('E',Result); if P <> 0 then begin @@ -1905,6 +1909,7 @@ Var UnexpectedDigits: Integer; { Number Of unexpected Digits that } { have To be inserted before the } { First placeholder. } + UnexpectedDigitsStart: Integer; { Location in Digits where first unexpected Digit is located } DigitExponent: Integer; { Exponent Of First digit In } { Digits Array. } @@ -2242,8 +2247,12 @@ Var Insert('e',Exponent,1); End; DigitExponent:=DecimalPoint-2; - If (Digits[1]='-') Then + I:=1; + While (I<=Length(Digits)) and (Digits[i] in [' ','-']) do + begin Dec(DigitExponent); + Inc(i); + end; UnexpectedDigits:=DecimalPoint-1-(Placehold[1]+Placehold[2]); End; @@ -2262,7 +2271,7 @@ Var Dig := 1; While (Fmt<FmtStop) Do Begin - //Write(Fmt[0]); +// WriteLn('Treating : "',Fmt[0],'"'); Case Fmt[0] Of #34: Begin @@ -2292,9 +2301,9 @@ Var Buf[0] := Digits[N]; Inc(Buf); end; - If thousand And (Digits[N]<>'-') Then + If thousand And (Not (Digits[N] in [' ','-'])) Then Begin - If (DigitExponent Mod 3 = 0) And (DigitExponent>0) and (N > 1) Then + If (DigitExponent Mod 3 = 0) And (DigitExponent>0) Then Begin Buf[0] := FormatSettings.ThousandSeparator; Inc(Buf); @@ -2317,8 +2326,9 @@ Var Inc(Buf); End; End; + if Digits[Dig]<>'-' then + Dec(DigitExponent); Inc(Dig); - Dec(DigitExponent); Inc(Fmt); End; 'e', 'E': diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc index 12067f969c..68aaddb55a 100644 --- a/rtl/objpas/sysutils/sysutils.inc +++ b/rtl/objpas/sysutils/sysutils.inc @@ -294,8 +294,10 @@ begin Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Addr),':'); if Obj is exception then Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message) + else if Obj is TObject then + Writeln(hstdout^,'Exception object ',Obj.ClassName,' is not of class Exception.') else - Writeln(hstdout^,'Exception object ',Obj.ClassName,' is not of class Exception.'); + Writeln(hstdout^,'Exception object is not ia valid class.'); Writeln(hstdout^,BackTraceStrFunc(Addr)); if (FrameCount>0) then begin diff --git a/rtl/objpas/types.pp b/rtl/objpas/types.pp index 27cfb28e31..495d9f8db3 100644 --- a/rtl/objpas/types.pp +++ b/rtl/objpas/types.pp @@ -21,14 +21,10 @@ unit types; Windows; {$endif Windows} - {$ifdef wince} - //roozbeh:the reason is currently RT_RCDATA is defines in windows for wince as constant, - // but in win32 it is function so here is required to redeclared. - //RT_RCDATA = PWideChar(10); - {$else} - const - RT_RCDATA = PChar(10); - {$endif} +{$ifdef mswindows} +const + RT_RCDATA = Windows.RT_RCDATA deprecated 'Use Windows.RT_RCDATA instead'; +{$endif mswindows} type DWORD = LongWord; diff --git a/rtl/objpas/unicodedata.pas b/rtl/objpas/unicodedata.pas index 4f9b907815..9827d3a714 100644 --- a/rtl/objpas/unicodedata.pas +++ b/rtl/objpas/unicodedata.pas @@ -207,7 +207,12 @@ type { TUC_Prop } - TUC_Prop = packed record + { On alignment-sensitive targets, at least some of them, assembler uses to forcibly align data >1 byte. + This breaks intended layout of initialized constants/variables. + A proper solution is to patch compiler to emit always unaligned directives for words/dwords/etc, + but for now just declare this record as "unpacked". This causes bloat, but it's better than having + entire unit not working at all. } + TUC_Prop = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif} record private function GetCategory : Byte;inline; procedure SetCategory(AValue : Byte); @@ -322,7 +327,7 @@ type TCollationName = string[128]; PUCA_DataBook = ^TUCA_DataBook; - TUCA_DataBook = packed record + TUCA_DataBook = record public Base : PUCA_DataBook; Version : TCollationName; |