pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add unit tests for HTML-to-RichText conversion (and vice versa).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6073 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-11-14 22:57:11 +00:00
parent f67d13f3b3
commit a8743226b7
2 changed files with 151 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
components/fpspreadsheet/source/common/fpshtmlutils.pas
View File

@ -931,6 +931,14 @@ end;
{@@ ----------------------------------------------------------------------------
Extracts rich-text parameters out of an html-formatted string and returns the
plain text
@@param AWorkbook Workbook in which the cell with this text will reside
@@param AFont Standard font used in the cell in which this text
will reside
@@param AHTMLText Input Text with html tags to be applied to the cell
@@param APlainText AHtmlText after removal of HTML tags, pure text
@@param ARichtTextParams Rich-text parameters corresponding to the embedded
html tags
-------------------------------------------------------------------------------}
procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont;
const AHTMLText: String; out APlainText: String;

167
components/fpspreadsheet/tests/internaltests.pas
View File

@ -17,7 +17,7 @@ uses
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpstypes, fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
fpsutils, fpsstreams, testsutility, md5;
fpsutils, fpsstreams, fpshtmlutils, testsutility, md5;
type
{ TSpreadReadInternalTests }
@ -33,6 +33,8 @@ type
procedure TearDown; override;
procedure FractionTest(AMaxDigits: Integer);
procedure HtmlToRichTextTest(ATestIndex: Integer);
procedure RichTextToHtmlTest(ATestIndex: Integer);
procedure WriteToStreamTest(AFormat: TsSpreadsheetFormat);
procedure InvalidSheetName(AFormat: TsSpreadsheetFormat);
@ -73,6 +75,15 @@ type
procedure FractionTest_1;
procedure FractionTest_2;
procedure FractionTest_3;
// Test HTML-Richtext conversion
procedure HtmlToRichTextTest_0;
procedure HtmlToRichTextTest_1;
procedure HtmlToRichTextTest_2;
procedure HtmlToRichTextTest_3;
procedure RichTextToHtmlTest_0;
procedure RichTextToHtmlTest_1;
procedure RichTextToHtmlTest_2;
procedure RichTextToHtmlTest_3;
end;
implementation
@ -764,29 +775,6 @@ begin
fail(Format('Conversion error: %g = %d/%d turns to %d/%d (=%g)', [sollValue, sollNum, sollDenom, actualNum, actualDenom, actualNum/actualdenom]));
end;
end;
(*
procedure TSpreadInternalTests.FractionTest_0;
const
N = 300;
var
j: Integer;
sollNum, sollDenom: Integer;
sollvalue: Double;
actualNum, actualDenom: Int64;
begin
sollNum := 1;
for j := 1 to N do
begin
sollDenom := j;
// sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom));
sollValue := 1.0/sollDenom;
// FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom);
FloatToFraction(sollvalue, 1000, actualNum, actualDenom);
if actualDenom > sollDenom then
fail(Format('Conversion error: approximated %d/%d turns to %d/%d', [sollNum, sollDenom, actualNum, actualDenom]));
end;
end;
*)
procedure TSpreadInternalTests.FractionTest_1;
begin
@ -803,6 +791,137 @@ begin
FractionTest(3);
end;
{------------------------------------------------------------------------------}
{ HTML-to-RichText conversion }
{------------------------------------------------------------------------------}
type
THtmlRichTextParam = record
HTML: String;
PlainText: String;
NumRichTextParams: 0..1;
RichTextParams: array[0..1] of TsRichTextParam;
end;
const
HtmlRTParams: array[0..3] of THtmlRichTextParam = (
(HTML: 'ABC'; PlainText: 'ABC';
NumRichTextParams: 0),
(HTML: 'ABC<b>abc</b>'; PlainText: 'ABCabc';
NumRichTextParams: 1;
RichTextParams: (
(FirstIndex:4; FontIndex:2; HyperlinkIndex:-1),
(FirstIndex:0; FontIndex:0; HyperlinkIndex:-1)
)
),
(HTML: 'ABC<b>abc</b>ABC'; PlainText: 'ABCabcABC';
NumRichTextParams: 2;
RichTextParams: (
(FirstIndex:4; FontIndex:2; HyperlinkIndex:-1),
(FirstIndex:7; FontIndex:0; HyperlinkIndex:-1)
)
),
(HTML: '<b>abc</b>ABC'; PlainText: 'abcABC';
NumRichTextParams: 2;
RichTextParams: (
(FirstIndex:1; FontIndex:2; HyperlinkIndex:-1),
(FirstIndex:4; FontIndex:0; HyperlinkIndex:-1)
)
)
);
procedure TSpreadInternalTests.HtmlToRichTextTest(ATestIndex: Integer);
var
book: TsWorkbook;
fnt: TsFont;
rtparams: TsRichTextParams;
plain: String;
i: Integer;
begin
book := TsWorkbook.Create;
try
fnt := book.GetDefaultFont;
HTMLToRichText(book, fnt, HTMLRtParams[ATestIndex].HTML, plain, rtParams);
CheckEquals(HtmlRTParams[ATestIndex].PlainText, plain, 'Plain text mismatch');
CheckEquals(HtmlRTParams[ATestIndex].NumRichTextParams, Length(rtParams),
'Count of rich-text params mismatch');
for i:=0 to HtmlRTParams[ATestIndex].NumRichTextParams-1 do begin
CheckEquals(HtmlRTParams[ATestIndex].RichTextParams[i].FirstIndex, rtParams[i].FirstIndex,
'RichTextParam['+IntToStr(i)+'].FirstIndex mismatch');
CheckEquals(HtmlRTParams[ATestIndex].RichTextParams[i].FontIndex, rtParams[i].FontIndex,
'RichTextParam['+IntToStr(i)+'].FontIndex mismatch');
end;
finally
book.Free;
end;
end;
procedure TSpreadInternalTests.RichTextToHtmlTest(ATestIndex: Integer);
var
book: TsWorkbook;
fnt: TsFont;
rtparams: TsRichTextParams;
html: String;
i: Integer;
begin
book := TsWorkbook.Create;
try
fnt := book.GetDefaultFont;
SetLength(rtParams, HTMLRtParams[ATestIndex].NumRichTextParams);
for i:=0 to HtmlRtParams[ATestindex].NumRichTextParams-1 do begin
rtParams[i].FirstIndex := HtmlRTParams[ATestIndex].RichTextParams[i].FirstIndex;
rtParams[i].FontIndex := HtmlRTParams[ATestIndex].RichTextParams[i].FontIndex;
end;
RichTextToHTML(book, fnt, HTMLRtParams[ATestIndex].PlainText, rtParams, html);
CheckEquals(HtmlRTParams[ATestIndex].HTML, html, 'HTML text mismatch');
finally
book.Free;
end;
end;
procedure TSpreadInternalTests.HtmlToRichTextTest_0;
begin
HtmlToRichTextTest(0);
end;
procedure TSpreadInternalTests.HtmlToRichTextTest_1;
begin
HtmlToRichTextTest(1);
end;
procedure TSpreadInternalTests.HtmlToRichTextTest_2;
begin
HtmlToRichTextTest(2);
end;
procedure TSpreadInternalTests.HtmlToRichTextTest_3;
begin
HtmlToRichTextTest(3);
end;
procedure TSpreadInternalTests.RichTextToHtmlTest_0;
begin
RichTextToHtmlTest(0);
end;
procedure TSpreadInternalTests.RichTextToHtmlTest_1;
begin
RichTextToHtmlTest(1);
end;
procedure TSpreadInternalTests.RichTextToHtmlTest_2;
begin
RichTextToHtmlTest(2);
end;
procedure TSpreadInternalTests.RichTextToHtmlTest_3;
begin
RichTextToHtmlTest(3);
end;
procedure TSpreadInternalTests.SetUp;
begin
end;