diff --git a/.gitattributes b/.gitattributes index 786f4db9e6..3ad54e9628 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2005,6 +2005,7 @@ packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain packages/fcl-base/src/wtex.pp svneol=native#text/plain packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain +packages/fcl-base/tests/tcbufferedfilestream.pp svneol=native#text/plain packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain diff --git a/packages/fcl-base/src/bufstream.pp b/packages/fcl-base/src/bufstream.pp index fb03c09b4e..81ae8d377a 100644 --- a/packages/fcl-base/src/bufstream.pp +++ b/packages/fcl-base/src/bufstream.pp @@ -3,6 +3,7 @@ Copyright (c) 1999-2000 by the Free Pascal development team Implement a buffered stream. + TBufferedFileStream contributed by José Mejuto, bug ID 30549. See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -27,8 +28,10 @@ Const Type +{ --------------------------------------------------------------------- + TBufStream - simple read or write buffer, for sequential reading/writing + ---------------------------------------------------------------------} - { TBufStream } TBufStream = Class(TOwnerStream) Private FTotalPos : Int64; @@ -70,12 +73,83 @@ Type Function Write(Const ABuffer; ACount : LongInt) : Integer; override; end; +{ --------------------------------------------------------------------- + TBufferedFileStream - + Multiple pages buffer for random access reading/writing in file. + ---------------------------------------------------------------------} + + TBufferedFileStream = class(TFileStream) + private + const + TSTREAMCACHEPAGE_SIZE_DEFAULT=4*1024; + TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT=8; + type + TStreamCacheEntry=record + IsDirty: Boolean; + LastTick: NativeUInt; + PageBegin: int64; + PageRealSize: integer; + Buffer: Pointer; + end; + PStreamCacheEntry=^TStreamCacheEntry; + private + FCachePages: array of PStreamCacheEntry; + FCacheLastUsedPage: integer; + FCacheStreamPosition: int64; + FCacheStreamSize: int64; + FOpCounter: NativeUInt; + FStreamCachePageSize: integer; + FStreamCachePageMaxCount: integer; + FEmergencyFlag: Boolean; + procedure ClearCache; + procedure WriteDirtyPage(const aPage: PStreamCacheEntry); + procedure WriteDirtyPage(const aIndex: integer); + procedure WriteDirtyPages; + procedure EmergencyWriteDirtyPages; + procedure FreePage(const aPage: PStreamCacheEntry; const aFreeBuffer: Boolean); inline; + function LookForPositionInPages: Boolean; + function ReadPageForPosition: Boolean; + function ReadPageBeforeWrite: Boolean; + function FreeOlderInUsePage(const aFreeBuffer: Boolean=false): PStreamCacheEntry; + function GetOpCounter: NativeUInt; inline; + function DoCacheRead(var Buffer; Count: Longint): Longint; + function DoCacheWrite(const Buffer; Count: Longint): Longint; + protected + function GetPosition: Int64; override; + procedure SetPosition(const Pos: Int64); override; + function GetSize: Int64; override; + procedure SetSize64(const NewSize: Int64); override; + procedure SetSize(NewSize: Longint); override;overload; + procedure SetSize(const NewSize: Int64); override;overload; + public + // Warning using Mode=fmOpenWrite because the write buffer + // needs to read, as this class is a cache system not a dumb buffer. + constructor Create(const AFileName: string; Mode: Word); + constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal); + destructor Destroy; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; overload; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + // Flush write-cache content to disk + procedure Flush; + // re-initialize the cache with aCacheBlockCount block + // of aCacheBlockSize bytes in each block. + procedure InitializeCache(const aCacheBlockSize: integer; const aCacheBlockCount: integer); + end; + + implementation Resourcestring - SErrCapacityTooSmall = 'Capacity is less than actual buffer size.'; + SErrCapacityTooSmall = 'Capacity is less than actual buffer size.'; SErrCouldNotFLushBuffer = 'Could not flush buffer'; - SErrInvalidSeek = 'Invalid buffer seek operation'; + SErrInvalidSeek = 'Invalid buffer seek operation'; + + SErrCacheUnexpectedPageDiscard ='CACHE: Unexpected behaviour. Discarded page.'; + SErrCacheUnableToReadExpected = 'CACHE: Unable to read expected bytes (Open for write only ?). Expected: %d, effective read: %d'; + SErrCacheUnableToWriteExpected ='CACHE: Unable to write expected bytes (Open for read only ?). Expected: %d, effective write: %d'; + SErrCacheInternal = 'CACHE: Internal error.'; { TBufStream } @@ -257,4 +331,518 @@ begin end; + +{ --------------------------------------------------------------------- + TBufferedFileStream + ---------------------------------------------------------------------} + +procedure TBufferedFileStream.ClearCache; +var + j: integer; + pStream: PStreamCacheEntry; +begin + try + WriteDirtyPages; + finally + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + pStream:=FCachePages[j]; + if Assigned(pStream) then begin + if Assigned(pStream^.Buffer) then Freemem(pStream^.Buffer); + Dispose(pStream); + FCachePages[j]:=nil; + end; + end; + end; +end; + +procedure TBufferedFileStream.WriteDirtyPage(const aPage: PStreamCacheEntry); +var + lEffectiveBytesWrite: integer; +begin + inherited Seek(aPage^.PageBegin,soBeginning); + lEffectiveBytesWrite:=inherited Write(aPage^.Buffer^,aPage^.PageRealSize); + if lEffectiveBytesWrite<>aPage^.PageRealSize then begin + EmergencyWriteDirtyPages; + Raise EStreamError.CreateFmt(SErrCacheUnableToWriteExpected,[aPage^.PageRealSize,lEffectiveBytesWrite,IntToStr(aPage^.PageBegin)]); + end; + aPage^.IsDirty:=False; + aPage^.LastTick:=GetOpCounter; +end; + +procedure TBufferedFileStream.WriteDirtyPage(const aIndex: integer); +var + pCache: PStreamCacheEntry; +begin + pCache:=FCachePages[aIndex]; + if Assigned(pCache) then begin + WriteDirtyPage(pCache); + end; +end; + +procedure TBufferedFileStream.WriteDirtyPages; +var + j: integer; + pCache: PStreamCacheEntry; +begin + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + pCache:=FCachePages[j]; + if Assigned(pCache) then begin + if pCache^.IsDirty then begin + WriteDirtyPage(pCache); + end; + end; + end; +end; + +procedure TBufferedFileStream.EmergencyWriteDirtyPages; +var + j: integer; + pCache: PStreamCacheEntry; +begin + // Are we already in a emergency write dirty pages ?? + if FEmergencyFlag then exit; + FEmergencyFlag:=true; + // This procedure tries to save all dirty pages inconditional + // because a write fail happens, so everything in cache will + // be dumped to stream if possible, trying to save as much + // information as possible. + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + pCache:=FCachePages[j]; + if Assigned(pCache) then begin + if pCache^.IsDirty then begin + try + WriteDirtyPage(pCache); + except on e: Exception do begin + // Do nothing, eat exception if happen. + // This way the cache still holds data to be + // written (that fails) and can be written later + // if write fail conditions change. + end; + end; + end; + end; + end; + FEmergencyFlag:=False; +end; + +procedure TBufferedFileStream.FreePage(const aPage: PStreamCacheEntry; + const aFreeBuffer: Boolean); +begin + aPage^.PageBegin:=0; + aPage^.PageRealSize:=0; + aPage^.LastTick:=0; + aPage^.IsDirty:=false; + if aFreeBuffer then begin + FreeMem(aPage^.Buffer); + aPage^.Buffer:=nil; + end; +end; + +function TBufferedFileStream.LookForPositionInPages: Boolean; +var + j: integer; + pCache: PStreamCacheEntry; +begin + Result:=false; + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + pCache:=FCachePages[j]; + if Assigned(pCache^.Buffer) then begin + if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition FCacheStreamSize then begin + lExpectedBytesToRead:=FCacheStreamSize-lStreamPosition; + end else begin + lExpectedBytesToRead:=FStreamCachePageSize; + end; + pCache^.PageBegin:=lStreamPosition; + pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize); + if pCache^.PageRealSize<>lExpectedBytesToRead then begin + lEffectiveRead:=pCache^.PageRealSize; + pCache^.IsDirty:=false; + pCache^.LastTick:=0; + pCache^.PageBegin:=0; + pCache^.PageRealSize:=0; + Freemem(pCache^.Buffer); + pCache^.Buffer:=nil; + Raise EStreamError.CreateFmt(SErrCacheUnableToReadExpected,[lExpectedBytesToRead,lEffectiveRead]); + end; + pCache^.LastTick:=GetOpCounter; + Result:=true; +end; + +function TBufferedFileStream.FreeOlderInUsePage(const aFreeBuffer: Boolean + ): PStreamCacheEntry; +var + j: integer; + lOlderTick: int64=High(int64); + lOlderEntry: integer=-1; +begin + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + Result:=FCachePages[j]; + if Assigned(Result^.Buffer) then begin + if Result^.LastTick=pCache^.PageBegin) and (FCacheStreamPosition=Count then begin + move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,Count); + inc(FCacheStreamPosition,Count); + Result:=Count; + pCache^.LastTick:=GetOpCounter; + exit; + end else begin + move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,lAvailableInThisPage); + inc(FCacheStreamPosition,lAvailableInThisPage); + if pCache^.PageRealSize=FStreamCachePageSize then begin + lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage; + Result:=lAvailableInThisPage+DoCacheRead(lNewBuffer^,Count-lAvailableInThisPage); + end else begin + // This cache page is not filled, so it is the last one + // in the file, nothing more to read... + pCache^.LastTick:=GetOpCounter; + Result:=lAvailableInThisPage; + end; + exit; + end; + end else begin + // The position is in other cache page or not in cache at all, so look for + // position in cached pages or allocate a new page. + if LookForPositionInPages then begin + Result:=DoCacheRead(Buffer,Count); + exit; + end else begin + if ReadPageForPosition then begin + Result:=DoCacheRead(Buffer,Count); + end else begin + Result:=0; + end; + exit; + end; + end; + end else begin + if ReadPageForPosition then begin + Result:=DoCacheRead(Buffer,Count); + end else begin + Result:=0; + end; + exit; + end; + end else begin + // The page has been discarded for some unknown reason + Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard); + end; +end; + +function TBufferedFileStream.DoCacheWrite(const Buffer; Count: Longint): Longint; +var + pCache: PStreamCacheEntry; + lAvailableInThisPage: integer; + lPositionInPage: integer; + lNewBuffer: PBYTE; +begin + pCache:=FCachePages[FCacheLastUsedPage]; + if Assigned(pCache) then begin + // Check if FCacheStreamPosition is in range + if Assigned(pCache^.Buffer) then begin + if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition=Count then begin + move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,Count); + if not pCache^.IsDirty then pCache^.IsDirty:=true; + inc(FCacheStreamPosition,Count); + // Update page size + if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+Count; + // Update file size + if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition; + Result:=Count; + pCache^.LastTick:=GetOpCounter; + exit; + end else begin + move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,lAvailableInThisPage); + if not pCache^.IsDirty then pCache^.IsDirty:=true; + inc(FCacheStreamPosition,lAvailableInThisPage); + // Update page size + if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+lAvailableInThisPage; + // Update file size + if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition; + + Assert(pCache^.PageRealSize=FStreamCachePageSize,'This must not happend'); + lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage; + Result:=lAvailableInThisPage+DoCacheWrite(lNewBuffer^,Count-lAvailableInThisPage); + exit; + end; + end else begin + // The position is in other cache page or not in cache at all, so look for + // position in cached pages or allocate a new page. + if LookForPositionInPages then begin + Result:=DoCacheWrite(Buffer,Count); + exit; + end else begin + if ReadPageBeforeWrite then begin + Result:=DoCacheWrite(Buffer,Count); + end else begin + Result:=0; + end; + exit; + end; + end; + end else begin + if ReadPageBeforeWrite then begin + Result:=DoCacheWrite(Buffer,Count); + end else begin + Result:=0; + end; + exit; + end; + end else begin + // The page has been discarded for some unknown reason + Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard); + end; +end; + +function TBufferedFileStream.GetPosition: Int64; +begin + Result:=FCacheStreamPosition; +end; + +procedure TBufferedFileStream.SetPosition(const Pos: Int64); +begin + if Pos<0 then begin + FCacheStreamPosition:=0; + end else begin + FCacheStreamPosition:=Pos; + end; +end; + +function TBufferedFileStream.GetSize: Int64; +begin + Result:=FCacheStreamSize; +end; + +procedure TBufferedFileStream.SetSize64(const NewSize: Int64); +var + j: integer; + pCache: PStreamCacheEntry; +begin + WriteDirtyPages; + inherited SetSize64(NewSize); + FCacheStreamSize:=inherited Seek(0,soFromEnd); + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + pCache:=FCachePages[j]; + if Assigned(pCache^.Buffer) and (pCache^.PageRealSize+pCache^.PageBegin>FCacheStreamSize) then begin + // This page is out of bounds the new file size + // so discard it. + FreePage(pCache,True); + break; + end; + end; +end; + +procedure TBufferedFileStream.SetSize(NewSize: Longint); +begin + SetSize64(NewSize); +end; + +procedure TBufferedFileStream.SetSize(const NewSize: Int64); +begin + SetSize64(NewSize); +end; + +constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word); +begin + // Initialize with 8 blocks of 4096 bytes + InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT); + inherited Create(AFileName,Mode); + FCacheStreamSize:=inherited Seek(int64(0),soEnd); +end; + +constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word; + Rights: Cardinal); +begin + // Initialize with 8 blocks of 4096 bytes + InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT); + inherited Create(AFileName,Mode,Rights); + FCacheStreamSize:=inherited Seek(int64(0),soEnd); +end; + +function TBufferedFileStream.Read(var Buffer; Count: Longint): Longint; +begin + Result:=DoCacheRead(Buffer,Count); +end; + +function TBufferedFileStream.Write(const Buffer; Count: Longint): Longint; +begin + Result:=DoCacheWrite(Buffer,Count); +end; + +procedure TBufferedFileStream.Flush; +begin + WriteDirtyPages; +end; + +function TBufferedFileStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + Result:=Seek(int64(OffSet),TSeekOrigin(Origin)); +end; + +function TBufferedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +var + lNewOffset: int64; +begin + Case Origin of + soEnd: + begin + lNewOffset:=FCacheStreamSize+Offset; + end; + soBeginning: + begin + lNewOffset:=0+Offset; + end; + soCurrent: + begin + lNewOffset:=FCacheStreamPosition+Offset; + end; + end; + if lNewOffset>0 then begin + FCacheStreamPosition:=lNewOffset; + Result:=lNewOffset; + end else begin + // This is compatible with FPC stream + // as it returns the negative value :-? + // but in fact does not move the read pointer. + Result:=-1; + end; +end; + +procedure TBufferedFileStream.InitializeCache(const aCacheBlockSize: integer; + const aCacheBlockCount: integer); +var + j: integer; +begin + ClearCache; + FStreamCachePageSize:=aCacheBlockSize; + FStreamCachePageMaxCount:=aCacheBlockCount; + FCacheStreamSize:=inherited Seek(0,soEnd); + SetLength(FCachePages,FStreamCachePageMaxCount); + for j := 0 to Pred(FStreamCachePageMaxCount) do begin + FCachePages[j]:=New(PStreamCacheEntry); + FillByte(FCachePages[j]^,Sizeof(PStreamCacheEntry^),0); + end; +end; + +destructor TBufferedFileStream.Destroy; +begin + ClearCache; + inherited Destroy; +end; + end. diff --git a/packages/fcl-base/src/csvreadwrite.pp b/packages/fcl-base/src/csvreadwrite.pp index eb776a3804..8e9738d6d6 100644 --- a/packages/fcl-base/src/csvreadwrite.pp +++ b/packages/fcl-base/src/csvreadwrite.pp @@ -124,7 +124,7 @@ Type // simple parsing procedure ParseValue; public - constructor Create; + constructor Create; override; destructor Destroy; override; // Source data stream procedure SetSource(AStream: TStream); overload; @@ -161,7 +161,7 @@ Type procedure AppendStringToStream(const AString: String; AStream: TStream); function QuoteCSVString(const AValue: String): String; public - constructor Create; + constructor Create; override; destructor Destroy; override; // Set output/destination stream. // If not called, output is sent to DefaultOutput @@ -455,6 +455,7 @@ var b: packed array[0..2] of byte; n: Integer; begin + B[0]:=0; B[1]:=0; B[2]:=0; ClearOutput; FSourceStream.Seek(0, soFromBeginning); if FDetectBOM then @@ -533,6 +534,7 @@ begin if StreamSize > 0 then begin SetLength(Result, StreamSize); + FDefaultOutput.Position:=0; FDefaultOutput.ReadBuffer(Result[1], StreamSize); end; end; diff --git a/packages/fcl-base/src/inifiles.pp b/packages/fcl-base/src/inifiles.pp index 72367e5378..0c3341ac84 100644 --- a/packages/fcl-base/src/inifiles.pp +++ b/packages/fcl-base/src/inifiles.pp @@ -1381,17 +1381,10 @@ begin if FEncoding=nil then slLines.LoadFromFile(FFileName) else - begin - slLines.DefaultEncoding := FEncoding; - slLines.LoadFromFile(FFileName, nil); - if FEncoding <> slLines.Encoding then begin - if FOwnsEncoding then - FEncoding.Free; - FEncoding := slLines.Encoding; - FOwnsEncoding := not TEncoding.IsStandardEncoding(FEncoding); + slLines.DefaultEncoding := FEncoding; // TStrings clones the encoding. + slLines.LoadFromFile(FFileName, nil); end; - end; FillSectionList(slLines); finally slLines.Free; diff --git a/packages/fcl-base/src/maskutils.pp b/packages/fcl-base/src/maskutils.pp index 9c1ea7229e..a3675c883e 100644 --- a/packages/fcl-base/src/maskutils.pp +++ b/packages/fcl-base/src/maskutils.pp @@ -308,7 +308,6 @@ end; // Clear (virtually) a single char in position Position function TMaskUtils.ClearChar(Position: Integer): Char; begin - Result := FMask[Position]; //For Delphi compatibilty, only literals remain, all others will be blanked case CharToMask(FMask[Position]) Of Char_Number, @@ -334,6 +333,8 @@ begin Char_AllFixedDownCase: Result := FSpaceChar; Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator; Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator; + else + Result := FMask[Position]; end; end; diff --git a/packages/fcl-base/src/streamex.pp b/packages/fcl-base/src/streamex.pp index 756f089496..92684d57b5 100644 --- a/packages/fcl-base/src/streamex.pp +++ b/packages/fcl-base/src/streamex.pp @@ -181,35 +181,33 @@ type TStreamHelper = class helper for TStream - - function ReadWordLE :word; - function ReadDWordLE:dword; - function ReadQWordLE:qword; - procedure WriteWordLE (w:word); - procedure WriteDWordLE(dw:dword); - procedure WriteQWordLE(dq:qword); - function ReadWordBE :word; - function ReadDWordBE:dword; - function ReadQWordBE:qword; - procedure WriteWordBE (w:word); - procedure WriteDWordBE(dw:dword); - procedure WriteQWordBE(dq:qword); - function ReadSingle:Single; - function ReadDouble:Double; - procedure WriteSingle(s:Single); - procedure WriteDouble(d:double); - - {$ifndef FPC} - function ReadByte : Byte; - function ReadWord : Word; - function ReadDWord : DWord; - function ReadQWord : QWord; - procedure WriteByte (b : Byte); - procedure WriteWord (b : word); - procedure WriteDWord (b : DWord); - procedure WriteQWord (b : QWord); - {$endif} - end; + function ReadWordLE :word; + function ReadDWordLE:dword; + function ReadQWordLE:qword; + procedure WriteWordLE (w:word); + procedure WriteDWordLE(dw:dword); + procedure WriteQWordLE(dq:qword); + function ReadWordBE :word; + function ReadDWordBE:dword; + function ReadQWordBE:qword; + procedure WriteWordBE (w:word); + procedure WriteDWordBE(dw:dword); + procedure WriteQWordBE(dq:qword); + function ReadSingle:Single; + function ReadDouble:Double; + procedure WriteSingle(s:Single); + procedure WriteDouble(d:double); + {$ifndef FPC} + function ReadByte : Byte; + function ReadWord : Word; + function ReadDWord : DWord; + function ReadQWord : QWord; + procedure WriteByte (b : Byte); + procedure WriteWord (b : word); + procedure WriteDWord (b : DWord); + procedure WriteQWord (b : QWord); + {$endif} + end; Implementation diff --git a/packages/fcl-base/tests/fclbase-unittests.lpi b/packages/fcl-base/tests/fclbase-unittests.lpi index 7bfa88bf0c..d910d16140 100644 --- a/packages/fcl-base/tests/fclbase-unittests.lpi +++ b/packages/fcl-base/tests/fclbase-unittests.lpi @@ -1,14 +1,15 @@ - + + + - <UseAppBundle Value="False"/> <ResourceType Value="res"/> @@ -16,28 +17,29 @@ <i18n> <EnableI18N LFM="False"/> </i18n> - <VersionInfo> - <StringTable ProductVersion=""/> - </VersionInfo> <BuildModes Count="1"> <Item1 Name="Default" Default="True"/> </BuildModes> <PublishOptions> <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> </PublishOptions> <RunParams> <local> - <FormatVersion Value="1"/> <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/> </local> + <FormatVersion Value="2"/> + <Modes Count="1"> + <Mode0 Name="default"> + <local> + <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/> + </local> + </Mode0> + </Modes> </RunParams> - <Units Count="6"> + <Units Count="7"> <Unit0> <Filename Value="fclbase-unittests.pp"/> <IsPartOfProject Value="True"/> - <UnitName Value="fclbase_unittests"/> </Unit0> <Unit1> <Filename Value="tchashlist.pp"/> @@ -59,6 +61,10 @@ <Filename Value="tccsvreadwrite.pp"/> <IsPartOfProject Value="True"/> </Unit5> + <Unit6> + <Filename Value="tcbufferedfilestream.pp"/> + <IsPartOfProject Value="True"/> + </Unit6> </Units> </ProjectOptions> <CompilerOptions> diff --git a/packages/fcl-base/tests/fclbase-unittests.pp b/packages/fcl-base/tests/fclbase-unittests.pp index 7e3bc567f4..33e79d4d0c 100644 --- a/packages/fcl-base/tests/fclbase-unittests.pp +++ b/packages/fcl-base/tests/fclbase-unittests.pp @@ -4,7 +4,7 @@ program fclbase_unittests; uses Classes, consoletestrunner, tests_fptemplate, tchashlist, - testexprpars, tcmaskutils, tcinifile, tccsvreadwrite; + testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream; var Application: TTestRunner; diff --git a/packages/fcl-base/tests/tcbufferedfilestream.pp b/packages/fcl-base/tests/tcbufferedfilestream.pp new file mode 100644 index 0000000000..0edeb9efe3 --- /dev/null +++ b/packages/fcl-base/tests/tcbufferedfilestream.pp @@ -0,0 +1,393 @@ +unit tcbufferedfilestream; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, bufstream; + +type + + { TTestBufferedFileStream } + + TTestBufferedFileStream= class(TTestCase) + private + const + TEST_RANDOM_READS=10000; + TEST_SEQUENTIAL_READS=1000000; + TEST_FILENAME='testfile.bin'; + TEST_WRITEC_FILE='testwritecache.bin'; + TEST_WRITEF_FILE='testwritedirec.bin'; + private + function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean; + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestCacheRead; + procedure TestCacheWrite; + procedure TestCacheSeek; + end; + +implementation + +procedure TTestBufferedFileStream.TestCacheRead; +var + lBufferedStream: TBufferedFileStream; + lStream: TFileStream; + b: array [0..10000-1] of char; + j,k: integer; + lBytesToRead: integer; + lEffectiveRead: integer; + {$IFDEF CHECK_AGAINST_FILE} + lEffectiveRead2: integer; + {$ENDIF} + lReadPosition: int64; + lCheckInitV: integer; + lTick: QWord; +begin + b[0]:=#0; // Avoid initalization hint + lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite); + lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite); + try + RandSeed:=1; + Randomize; + lTick:=GetTickCount64; + for j := 0 to Pred(TEST_RANDOM_READS) do begin + lBytesToRead:=Random(10000); + lReadPosition:=Random(lBufferedStream.Size); + lBufferedStream.Position:=lReadPosition; + + lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead); + + {$IFDEF CHECK_AGAINST_FILE} + // Now read without cache + lStream.Position:=lReadPosition; + lEffectiveRead2:=lStream.Read(b2,lBytesToRead); + if lEffectiveRead<>lEffectiveRead2 then begin + FAIL('Read length mismatch'); + end; + if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin + FAIL('Compare buffer data error'); + end; + F.Position:=0; + {$ELSE} + lCheckInitV:=lReadPosition mod 10; + for k := 0 to Pred(lEffectiveRead) do begin + if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin + FAIL('Expected data error'); + end; + inc(lCheckInitV); + end; + {$ENDIF} + end; + // Writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.'); + + RandSeed:=1; + Randomize; + + // Writeln('Same operation without cache'); + lTick:=GetTickCount64; + for j := 0 to Pred(TEST_RANDOM_READS) do begin + lBytesToRead:=Random(10000); + lReadPosition:=Random(lBufferedStream.Size); + + lStream.Position:=lReadPosition; + lEffectiveRead:=lStream.Read(b,lBytesToRead); + + lCheckInitV:=lReadPosition mod 10; + for k := 0 to Pred(lEffectiveRead) do begin + if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin + FAIL('Expected data error'); + end; + inc(lCheckInitV); + end; + end; + // Writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.'); + + // Writeln('Check sequential read'); + + RandSeed:=1; + Randomize; + lTick:=GetTickCount64; + lBytesToRead:=1; + lReadPosition:=0; + lBufferedStream.Position:=lReadPosition; + lStream.Position:=lReadPosition; + for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin + + lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead); + + {$IFDEF CHECK_AGAINST_FILE} + // Now read without cache + lEffectiveRead2:=lStream.Read(b2,lBytesToRead); + if lEffectiveRead<>lEffectiveRead2 then begin + FAIL('Read length mismatch'); + end; + if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin + FAIL('Compare buffer data error'); + end; + F.Position:=0; + {$ELSE} + lCheckInitV:=lReadPosition mod 10; + for k := 0 to Pred(lEffectiveRead) do begin + if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin + FAIL('Expected data error'); + end; + inc(lCheckInitV); + end; + {$ENDIF} + inc(lReadPosition,lBytesToRead); + end; + // Writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.'); + + RandSeed:=1; + Randomize; + lTick:=GetTickCount64; + lBytesToRead:=1; + lReadPosition:=0; + lStream.Position:=lReadPosition; + for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin + + lEffectiveRead:=lStream.Read(b,lBytesToRead); + + lCheckInitV:=lReadPosition mod 10; + for k := 0 to Pred(lEffectiveRead) do begin + if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin + FAIL('Expected data error'); + end; + inc(lCheckInitV); + end; + inc(lReadPosition,lBytesToRead); + end; + // Writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.'); + + // Writeln('CACHE Trying read beyond limits'); + lBufferedStream.Position:=lBufferedStream.Size-1; + lEffectiveRead:=lBufferedStream.Read(b,2); + if lEffectiveRead<>1 then begin + FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead)); + end else begin + // Writeln('CACHE OK, read beyond limits returns 0 bytes.'); + end; + finally + lBufferedStream.Free; + lStream.Free; + end; +end; + +procedure TTestBufferedFileStream.TestCacheWrite; +const + EXPECTED_SIZE=10000000; + TEST_ROUNDS=100000; +var + lBufferedStream: TBufferedFileStream; + lStream: TFileStream; + lVerifyStream1,lVerifyStream2: TFileStream; + b: array [0..10000-1] of char; + j: integer; + lBytesToWrite: integer; + lWritePosition: int64; +begin + // Writeln('Testing write cache'); + // All test should return the same random sequence + RandSeed:=1; + Randomize; + for j := 0 to Pred(10000) do begin + b[j]:='0'; + end; + lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate); + lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate); + try + for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin + lBufferedStream.Write(b,sizeof(b)); + lStream.Write(b,sizeof(b)); + end; + for j := 0 to Pred(Sizeof(b)) do begin + b[j]:=char(ord('0')+j mod 10); + end; + finally + lBufferedStream.Free; + lStream.Free; + end; + lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite); + lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite); + try + for j := 0 to Pred(TEST_ROUNDS) do begin + if lStream.Size<>lBufferedStream.Size then begin + FAIL('Mismatched lengths'); + end; + lWritePosition:=Random(EXPECTED_SIZE); + lBytesToWrite:=Random(sizeof(b)); + lBufferedStream.Position:=lWritePosition; + lStream.Position:=lWritePosition; + lBufferedStream.Write(b,lBytesToWrite); + lStream.Write(b,lBytesToWrite); + // if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13); + end; + // Writeln(TEST_ROUNDS,' / ',TEST_ROUNDS); + if lStream.Size<>lBufferedStream.Size then begin + FAIL('Mismatched lengths'); + end; + finally + lBufferedStream.Free; + lStream.Free; + end; + + // Verify both generated files are identical. + lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite); + lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite); + try + if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin + FAIL('Streams are different!!'); + end else begin + // Writeln('Streams are identical. OK.'); + end; + finally + lVerifyStream1.Free; + lVerifyStream2.Free; + end; +end; + +procedure TTestBufferedFileStream.TestCacheSeek; +var + lBufferedStream: TBufferedFileStream; + lStream: TFileStream; + bBuffered: array [0..10000] of BYTE; + bStream: array [0..10000] of BYTE; + bread : Integer; + +begin + bBuffered[0]:=0; // Avoid initalization hint + bStream[0]:=0; // Avoid initalization hint + lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite); + lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite); + try + // Writeln('Set position=-1'); + lStream.Position:=-1; + // Writeln('TFileStream position=',lStream.Position); + lBufferedStream.Position:=-1; + // Writeln('Buffered position=',lBufferedStream.Position); + if lStream.Position<>lBufferedStream.Position then begin + FAIL('Positions are not the same.'); + end else begin + // Writeln('Positions are the same.'); + end; + + // Writeln('Read data when position=-1'); + bread:=lStream.Read(bBuffered[0],10); + // Writeln('TFileStream read bytes : ',bread); + // Writeln('TFileStream end position: ',lStream.Position); + bread:=lBufferedStream.Read(bStream[0],10); + // Writeln('Buffered read bytes: ',bread); + // Writeln('Buffered end position: ',lBufferedStream.Position); + if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin + FAIL('Read data or positions are not the same.'); + end else begin + // Writeln('Read data at -1 is the same.'); + end; + + // Writeln('Testing Seek operations'); + // Writeln('Seek -1 from beginning'); + bread:=lStream.Seek(-1,soBeginning); + // Writeln('Stream seek result : ',bread); + bread:=lBufferedStream.Seek(-1,soBeginning); + // Writeln('Buffered seek result: ',); + + // Writeln('Read data when Seek -1'); + bread:=lStream.Read(bBuffered[0],10); + // Writeln('TFileStream read bytes : ',bread); + // Writeln('TFileStream end position: ',lStream.Position); + bread:=lBufferedStream.Read(bStream[0],10); + // Writeln('Buffered read bytes: ',bread); + // Writeln('Buffered end position: ',lBufferedStream.Position); + if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin + FAIL('Read data or positions are not the same.'); + end else begin + // Writeln('Read data at -1 is the same.'); + end; + + // Writeln('Seek -current*2 from current'); + bread:=lStream.Seek(lStream.Position*-2,soCurrent); + // Writeln('Stream seek result : ',bread); + bread:=lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent); + // Writeln('Buffered seek result: ',bread); + // Writeln('Read data when Seek from current -current*2'); + bread:=lStream.Read(bBuffered[0],10); + // Writeln('TFileStream read bytes : ',bread); + // Writeln('TFileStream end position: ',lStream.Position); + bread:=lBufferedStream.Read(bStream[0],10); + // Writeln('Buffered read bytes: ',); + // Writeln('Buffered end position: ',lBufferedStream.Position); + if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin + FAIL('Read data or positions are not the same.'); + end else begin + // Writeln('Read data at -current*2 is the same.'); + end; + finally + lBufferedStream.Free; + lStream.Free; + end; +end; + +procedure TTestBufferedFileStream.SetUp; +var + F: TFileStream; + b: array [0..10000-1] of char; + j: integer; +begin + for j := 0 to Pred(10000) do begin + b[j]:=char(ord('0')+j mod 10); + end; + F:=TFileStream.Create(TEST_FILENAME,fmCreate); + for j := 0 to Pred(1000) do begin + F.Write(b,sizeof(b)); + end; + F.Free; +end; + +procedure TTestBufferedFileStream.TearDown; +begin + DeleteFile(TEST_FILENAME); + DeleteFile(TEST_WRITEC_FILE); + DeleteFile(TEST_WRITEF_FILE); +end; + +function TTestBufferedFileStream.CompareStreams(const aStream1: TStream; + const aStream2: TStream): Boolean; +const + BUFFER_SIZE=5213; // Odd number +var + b1: array [0..BUFFER_SIZE-1] of BYTE; + b2: array [0..BUFFER_SIZE-1] of BYTE; + lReadBytes: integer; + lAvailable: integer; + lEffectiveRead1: integer; + lEffectiveRead2: integer; +begin + b1[0]:=0; // Avoid initalization hint + b2[0]:=0; // Avoid initalization hint + Result:=false; + if aStream1.Size<>aStream2.Size then exit; + aStream1.Position:=0; + aStream2.Position:=0; + while aStream1.Position<aStream1.Size do begin + lAvailable:=aStream1.Size-aStream1.Position; + if lAvailable>=BUFFER_SIZE then begin + lReadBytes:=BUFFER_SIZE; + end else begin + lReadBytes:=aStream1.Size-aStream1.Position; + end; + lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes); + lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes); + if lEffectiveRead1<>lEffectiveRead2 then exit; + if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit; + end; + Result:=true; +end; + +initialization + RegisterTest(TTestBufferedFileStream); +end. + diff --git a/packages/fcl-net/src/netdb.pp b/packages/fcl-net/src/netdb.pp index 41d96fee0d..beeeb71c77 100644 --- a/packages/fcl-net/src/netdb.pp +++ b/packages/fcl-net/src/netdb.pp @@ -1033,7 +1033,7 @@ begin end; end; -Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer; +Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String; Recurse: Integer) : Integer; Var @@ -1056,13 +1056,29 @@ begin I:=0; While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do begin - if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then - begin - Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen); - inc(Result); - RR.RDLength := ntohs(RR.RDLength); - Inc(AnsStart,RR.RDLength); - end; + Case Ntohs(RR.AType) of + DNSQRY_PTR: + if (1=NtoHS(RR.AClass)) then + begin + Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen); + inc(Result); + RR.RDLength := ntohs(RR.RDLength); + Inc(AnsStart,RR.RDLength); + end; + DNSQRY_CNAME: + begin + if Recurse >= MaxRecursion then + begin + Result := -1; + exit; + end; + rr.rdlength := ntohs(rr.rdlength); + setlength(Address, rr.rdlength); + address := stringfromlabel(ans.payload, ansstart); + Result := ResolveAddressAt(Resolver, Address, Names, Recurse+1); + exit; + end; + end; Inc(I); end; end; @@ -1084,7 +1100,7 @@ begin S:=Format('%d.%d.%d.%d.in-addr.arpa',[nt.s_bytes[4],nt.s_bytes[3],nt.s_bytes[2],nt.s_bytes[1]]); While (Result=0) and (I<=high(DNSServers)) do begin - Result:=ResolveAddressAt(I,S,Addresses); + Result:=ResolveAddressAt(I,S,Addresses,1); Inc(I); end; end; @@ -1111,7 +1127,7 @@ begin I := 0; While (Result=0) and (I<=high(DNSServers)) do begin - Result:=ResolveAddressAt(I,S,Addresses); + Result:=ResolveAddressAt(I,S,Addresses,1); Inc(I); end; end; diff --git a/packages/openssl/src/openssl.pas b/packages/openssl/src/openssl.pas index 2da43c6db1..36901248bb 100644 --- a/packages/openssl/src/openssl.pas +++ b/packages/openssl/src/openssl.pas @@ -1156,7 +1156,7 @@ var procedure ErrClearError; procedure ErrFreeStrings; procedure ErrRemoveState(pid: cInt); - procedure RandScreen; + procedure RandScreen; deprecated 'Deprecated as of 1.1+'; function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt; procedure PKCS12free(p12: SslPtr); @@ -5663,8 +5663,6 @@ begin _SslLoadErrorStrings; if assigned(_OPENSSLaddallalgorithms) then _OPENSSLaddallalgorithms; - if assigned(_RandScreen) then - _RandScreen; if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then InitLocks; SSLloaded := True; diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp index 40623f1dda..3e5e7ded9c 100644 --- a/utils/fpdoc/dw_html.pp +++ b/utils/fpdoc/dw_html.pp @@ -145,6 +145,8 @@ type procedure DescrEndItalic; override; procedure DescrBeginEmph; override; procedure DescrEndEmph; override; + procedure DescrBeginUnderline; override; + procedure DescrEndUnderline; override; procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override; procedure DescrWriteFileEl(const AText: DOMString); override; procedure DescrWriteKeywordEl(const AText: DOMString); override; @@ -1101,6 +1103,16 @@ begin PopOutputNode; end; +procedure THTMLWriter.DescrBeginUnderline; +begin + PushOutputNode(CreateEl(CurOutputNode, 'u')); +end; + +procedure THTMLWriter.DescrEndUnderline; +begin + PopOutputNode; +end; + procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); Var diff --git a/utils/fpdoc/dw_latex.pp b/utils/fpdoc/dw_latex.pp index 8632cf2621..ce04c3a082 100644 --- a/utils/fpdoc/dw_latex.pp +++ b/utils/fpdoc/dw_latex.pp @@ -87,6 +87,8 @@ Type procedure DescrEndItalic; override; procedure DescrBeginEmph; override; procedure DescrEndEmph; override; + procedure DescrBeginUnderline; override; + procedure DescrEndUnderline; override; procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override; procedure DescrWriteFileEl(const AText: DOMString); override; procedure DescrWriteKeywordEl(const AText: DOMString); override; @@ -287,6 +289,16 @@ begin Write('}'); end; +procedure TLaTeXWriter.DescrBeginUnderline; +begin + Write('\underline{'); +end; + +procedure TLaTeXWriter.DescrEndUnderline; +begin + Write('}'); +end; + procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); Var diff --git a/utils/fpdoc/dw_linrtf.pp b/utils/fpdoc/dw_linrtf.pp index 7efbecf504..dd25f5a7f0 100644 --- a/utils/fpdoc/dw_linrtf.pp +++ b/utils/fpdoc/dw_linrtf.pp @@ -121,6 +121,8 @@ type procedure DescrEndItalic; override; procedure DescrBeginEmph; override; procedure DescrEndEmph; override; + procedure DescrBeginUnderline; override; + procedure DescrEndUnderline; override; procedure DescrWriteFileEl(const AText: DOMString); override; procedure DescrWriteKeywordEl(const AText: DOMString); override; procedure DescrWriteVarEl(const AText: DOMString); override; @@ -344,6 +346,16 @@ begin Write('}') end; +procedure TRTFWriter.DescrBeginUnderline; +begin + Write('{\ul '); +end; + +procedure TRTFWriter.DescrEndUnderline; +begin + Write('}'); +end; + procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString); begin Write('{\f0 '); diff --git a/utils/fpdoc/dw_man.pp b/utils/fpdoc/dw_man.pp index c6900bdd33..1874bdf1ef 100644 --- a/utils/fpdoc/dw_man.pp +++ b/utils/fpdoc/dw_man.pp @@ -138,6 +138,8 @@ Type procedure DescrEndItalic; override; procedure DescrBeginEmph; override; procedure DescrEndEmph; override; + procedure DescrBeginUnderline; override; + procedure DescrEndUnderline; override; procedure DescrWriteFileEl(const AText: DOMString); override; procedure DescrWriteKeywordEl(const AText: DOMString); override; procedure DescrWriteVarEl(const AText: DOMString); override; @@ -425,6 +427,17 @@ begin NewLine; end; +procedure TManWriter.DescrBeginUnderline; +begin + NewLine; + Write('.I '); //use ITALIC! +end; + +procedure TManWriter.DescrEndUnderline; +begin + NewLine; +end; + procedure TManWriter.DescrWriteFileEl(const AText: DOMString); Var diff --git a/utils/fpdoc/dw_txt.pp b/utils/fpdoc/dw_txt.pp index 234d5187db..47780cfbbe 100644 --- a/utils/fpdoc/dw_txt.pp +++ b/utils/fpdoc/dw_txt.pp @@ -89,6 +89,8 @@ Type procedure DescrEndItalic; override; procedure DescrBeginEmph; override; procedure DescrEndEmph; override; + procedure DescrBeginUnderline; override; + procedure DescrEndUnderline; override; procedure DescrWriteFileEl(const AText: DOMString); override; procedure DescrWriteKeywordEl(const AText: DOMString); override; procedure DescrWriteVarEl(const AText: DOMString); override; @@ -270,6 +272,14 @@ procedure TTXTWriter.DescrEndEmph; begin end; +procedure TTXTWriter.DescrBeginUnderline; +begin +end; + +procedure TTXTWriter.DescrEndUnderline; +begin +end; + procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString); begin DescrWriteText(AText); diff --git a/utils/fpdoc/dwriter.pp b/utils/fpdoc/dwriter.pp index ca7faa2a14..5b427e1720 100644 --- a/utils/fpdoc/dwriter.pp +++ b/utils/fpdoc/dwriter.pp @@ -117,6 +117,8 @@ type procedure DescrEndBold; virtual; abstract; procedure DescrBeginItalic; virtual; abstract; procedure DescrEndItalic; virtual; abstract; + procedure DescrBeginUnderline; virtual; abstract; + procedure DescrEndUnderline; virtual; abstract; procedure DescrBeginEmph; virtual; abstract; procedure DescrEndEmph; virtual; abstract; procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual; @@ -637,6 +639,12 @@ begin ConvertBaseShortList(AContext, Node, False); DescrEndEmph; end else + if Node.NodeName = 'u' then + begin + DescrBeginUnderline; + ConvertBaseShortList(AContext, Node, False); + DescrEndUnderline; + end else if Node.NodeName = 'file' then DescrWriteFileEl(ConvertTextContent) else if Node.NodeName = 'kw' then