paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-xml testing suite, working around excessive string conversions by using new method assertEqualsW to compare wide strings. Since TTestCase.assertEquals method already exists with ansistring arguments, and its first argument is a literal in most cases, overloading does not help here.

Browse Source 
git-svn-id: trunk@20442 -
This commit is contained in:
sergei 2012-02-29 09:28:03 +00:00
parent d59c0237b2
commit 134e5167f1
4 changed files with 61 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/fcl-xml/tests/domunit.pp
View File

@ -20,7 +20,7 @@ unit domunit;
interface
uses
Classes, SysUtils, DOM, XMLRead, contnrs, fpcunit;
Classes, SysUtils, xmlutils, DOM, XMLRead, contnrs, fpcunit;
type
{ these two types are separated for the purpose of readability }
@ -42,7 +42,7 @@ type
procedure GC(obj: TObject);
procedure Load(out doc; const uri: string);
procedure LoadStringData(out Doc; const data: string);
function getResourceURI(const res: WideString): WideString;
function getResourceURI(const res: XMLString): XMLString;
function ContentTypeIs(const t: string): Boolean;
function GetImplementation: TDOMImplementation;
procedure CheckFeature(const name: string);
@ -50,6 +50,7 @@ type
procedure assertEquals(const id: string; exp, act: TObject); overload;
procedure assertEqualsList(const id: string; const exp: array of DOMString; const act: _list);
procedure assertEqualsCollection(const id: string; const exp: array of DOMString; const act: _collection);
procedure assertEqualsW(const id: string; const exp, act: DOMString);
procedure assertEqualsNoCase(const id: string; const exp, act: DOMString);
procedure assertSame(const id: string; exp, act: TDOMNode);
procedure assertSize(const id: string; size: Integer; obj: TDOMNodeList);
@ -58,7 +59,7 @@ type
procedure assertURIEquals(const id: string;
scheme, path, host, file_, name, query, fragment: PChar;
IsAbsolute: Boolean; const Actual: DOMString);
function bad_condition(const TagName: WideString): Boolean;
function bad_condition(const TagName: XMLString): Boolean;
property implementationAttribute[const name: string]: Boolean read getImplAttr write setImplAttr;
end;
@ -120,7 +121,7 @@ begin
assertNotNull(id, exp);
assertNotNull(id, act);
assertEquals(id, exp.nodeType, act.nodeType);
assertEquals(id, exp.nodeValue, act.nodeValue);
assertEqualsW(id, exp.nodeValue, act.nodeValue);
end;
end;
@ -140,10 +141,10 @@ procedure TDOMTestBase.assertEqualsList(const id: string;
var
I: Integer;
begin
AssertEquals(id, Length(exp), Length(act));
AssertEquals(id+'(length)', Length(exp), Length(act));
// compare ordered
for I := 0 to High(exp) do
AssertEquals(id, exp[I], act[I]);
AssertEqualsW(id+'['+IntToStr(I)+']', exp[I], act[I]);
end;
procedure TDOMTestBase.assertEqualsCollection(const id: string; const exp: array of DOMString; const act: _collection);
@ -163,6 +164,11 @@ begin
end;
end;
procedure TDOMTestBase.assertEqualsW(const id: string; const exp, act: DOMString);
begin
AssertTrue(id + ComparisonMsg(exp, act), exp = act);
end;
procedure TDOMTestBase.assertEqualsNoCase(const id: string; const exp, act: DOMString);
begin
// TODO: could write custom comparison because range is limited to ASCII
@ -181,11 +187,11 @@ begin
AssertEquals(id, size, obj.Length);
end;
function TDOMTestBase.getResourceURI(const res: WideString): WideString;
function TDOMTestBase.getResourceURI(const res: XMLString): XMLString;
var
Base, Base2: WideString;
Base, Base2: XMLString;
function CheckFile(const uri: WideString; out name: WideString): Boolean;
function CheckFile(const uri: XMLString; out name: XMLString): Boolean;
var
filename: string;
begin
@ -196,7 +202,7 @@ end;
begin
Base := GetTestFilesURI;
if Pos(WideString('level2/html'), Base) <> 0 then
if Pos(XMLString('level2/html'), Base) <> 0 then
begin
// This is needed to run HTML testsuite off the CVS snapshot.
// Web version simply uses all level1 files copied to level2.
@ -287,9 +293,9 @@ begin
AssertEquals(id, string(name), ChangeFileExt(URI.Document, ''));
end;
function TDOMTestBase.bad_condition(const TagName: WideString): Boolean;
function TDOMTestBase.bad_condition(const TagName: XMLString): Boolean;
begin
Fail('Unsupported condition: '+ TagName);
Fail('Unsupported condition: '+ AnsiString(TagName));
Result := False;
end;

44
packages/fcl-xml/tests/extras.pp
View File

@ -31,6 +31,7 @@ type
procedure attr_ownership04;
procedure attr_ownership05;
procedure replacesamechild;
procedure insertbeforefirst;
procedure nsFixup1;
procedure nsFixup2;
procedure nsFixup3;
@ -149,15 +150,32 @@ begin
el := root.ChildNodes[1];
prev := el.PreviousSibling;
next := el.NextSibling;
AssertEquals('prev_name_before', 'child1', prev.NodeName);
AssertEquals('next_name_before', 'child3', next.NodeName);
AssertEqualsW('prev_name_before', 'child1', prev.NodeName);
AssertEqualsW('next_name_before', 'child3', next.NodeName);
root.replaceChild(el, el);
prev := el.PreviousSibling;
next := el.NextSibling;
AssertNotNull('prev_after', prev);
AssertNotNull('prev_after', next);
AssertEquals('prev_name_after', 'child1', prev.NodeName);
AssertEquals('next_name_after', 'child3', next.NodeName);
AssertEqualsW('prev_name_after', 'child1', prev.NodeName);
AssertEqualsW('next_name_after', 'child3', next.NodeName);
end;
// verify that inserting a node before the first child sets
// both refnode.previoussibling and newnode.nextsibling properties
procedure TDOMTestExtra.insertbeforefirst;
var
doc: TDOMDocument;
root, refchild, newchild: TDOMNode;
begin
LoadStringData(doc, '<root><child1/><child2/><child3/></root>');
root := doc.DocumentElement;
refchild := root.FirstChild;
newchild := doc.CreateElement('new');
root.insertbefore(newchild, refchild);
AssertEquals('prev', refchild.previoussibling, newchild);
AssertEquals('next', newchild.nextsibling, refchild);
AssertEquals('child', root.firstchild, newchild);
end;
const
@ -190,13 +208,13 @@ begin
LoadStringData(parsedDoc, stream.DataString);
docElem := parsedDoc.documentElement;
assertEquals('docElemLocalName', 'test', docElem.localName);
assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
assertEqualsW('docElemLocalName', 'test', docElem.localName);
assertEqualsW('docElemNS', nsURI1, docElem.namespaceURI);
list := docElem.GetElementsByTagNameNS(nsURI2, '*');
assertEquals('ns2_elementCount', 1, list.Length);
el := TDOMElement(list[0]);
assertEquals('ns2_nodeName', 'test', el.nodeName);
assertEqualsW('ns2_nodeName', 'test', el.nodeName);
end;
// verify the namespace fixup with two nested elements
@ -225,13 +243,13 @@ begin
LoadStringData(parsedDoc, stream.DataString);
docElem := parsedDoc.documentElement;
assertEquals('docElemLocalName', 'test', docElem.localName);
assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
assertEqualsW('docElemLocalName', 'test', docElem.localName);
assertEqualsW('docElemNS', nsURI1, docElem.namespaceURI);
list := docElem.GetElementsByTagNameNS(nsURI2, '*');
assertEquals('ns2_elementCount', 1, list.Length);
el := TDOMElement(list[0]);
assertEquals('ns2_nodeName', 'b:test', el.nodeName);
assertEqualsW('ns2_nodeName', 'b:test', el.nodeName);
end;
// verify the namespace fixup with two nested elements and an attribute
@ -262,14 +280,14 @@ begin
LoadStringData(parsedDoc, stream.DataString);
docElem := parsedDoc.documentElement;
assertEquals('docElemLocalName', 'test', docElem.localName);
assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
assertEqualsW('docElemLocalName', 'test', docElem.localName);
assertEqualsW('docElemNS', nsURI1, docElem.namespaceURI);
list := docElem.GetElementsByTagNameNS(nsURI2, '*');
assertEquals('ns2_elementCount', 1, list.Length);
el := TDOMElement(list[0]);
attr := el.GetAttributeNodeNS(nsURI1, 'attr');
assertEquals('attr_nodeName', 'a:attr', attr.nodeName);
assertEqualsW('attr_nodeName', 'a:attr', attr.nodeName);
end;

18
packages/fcl-xml/tests/extras2.pp
View File

@ -116,7 +116,7 @@ begin
nodeType := node.nodeType;
assertEquals('PIisFifthChild', 7, nodeType);
nodeValue := TDOMProcessingInstruction(node).data;
assertEquals('trailingPIData', '', nodeValue);
assertEqualsW('trailingPIData', '', nodeValue);
node := node.nextSibling;
nodeType := node.nodeType;
assertEquals('TextisSixthChild', 3, nodeType);
@ -178,7 +178,7 @@ begin
nodeType := node.nodeType;
assertEquals('PIisFifthChild', 7, nodeType);
nodeValue := TDOMProcessingInstruction(node).data;
assertEquals('trailingPIData', '', nodeValue);
assertEqualsW('trailingPIData', '', nodeValue);
node := node.nextSibling;
assertNull('SixthIsNull', node);
end;
@ -223,7 +223,7 @@ begin
attrSpecified := attr.specified;
assertTrue('titleSpecified', attrSpecified);
attrValue := attr.nodeValue;
assertEquals('titleValue', 'default', attrValue);
assertEqualsW('titleValue', 'default', attrValue);
end;
{ tests that namespace fixup is done while serializing }
@ -256,11 +256,11 @@ begin
docElem := parsedDoc.documentElement;
docElemLocalName := docElem.localName;
assertEquals('docElemLocalName', 'test', docElemLocalName);
assertEqualsW('docElemLocalName', 'test', docElemLocalName);
docElemNS := TDOMNode(docElem).namespaceURI;
assertEquals('docElemNS', namespaceURI, docElemNS);
assertEqualsW('docElemNS', namespaceURI, docElemNS);
attrValue := docElem.getAttributeNS(namespaceURI, 'attr');
assertEquals('properNSAttrValue', 'test value', attrValue);
assertEqualsW('properNSAttrValue', 'test value', attrValue);
end;
{ tests that namespace fixup is done while serializing }
@ -293,11 +293,11 @@ begin
docElem := parsedDoc.documentElement;
docElemLocalName := docElem.localName;
assertEquals('docElemLocalName', 'test', docElemLocalName);
assertEqualsW('docElemLocalName', 'test', docElemLocalName);
docElemNS := TDOMNode(docElem).namespaceURI;
assertEquals('docElemNS', namespaceURI, docElemNS);
assertEqualsW('docElemNS', namespaceURI, docElemNS);
attrValue := docElem.getAttributeNS(namespaceURI, 'attr');
assertEquals('properNSAttrValue', 'test value', attrValue);
assertEqualsW('properNSAttrValue', 'test value', attrValue);
end;
initialization

4
packages/fcl-xml/tests/testgen.pp
View File

@ -427,6 +427,8 @@ begin
rslt.Add(indent + 'AssertEqualsCollection(''' + node['id'] + ''', ' + ReplaceQuotes(node['expected']) + ', ' + node['actual'] + ');')
else if cond = '_list' then
rslt.Add(indent + 'AssertEqualsList(''' + node['id'] + ''', ' + ReplaceQuotes(node['expected']) + ', ' + node['actual'] + ');')
else if cond = 'DOMString' then
rslt.Add(indent + 'AssertEqualsW(''' + node['id'] + ''', ' + ReplaceQuotes(node['expected']) + ', ' + node['actual'] + ');')
else if node['ignoreCase'] = 'true' then
rslt.Add(indent + 'AssertEqualsNoCase(''' + node['id'] + ''', ' + ReplaceQuotes(node['expected']) + ', ' + node['actual'] + ');')
else
@ -975,7 +977,7 @@ begin
if ParamCount < 2 then
begin
writeln;
writeln('Usage: ', ParamStr(0), ' <suite dir> <outputunit.pp> [-f]');
writeln('Usage: ', ExtractFileName(ParamStr(0)), ' <suite dir> <outputunit.pp> [-f]');
writeln(' -f: force conversion of tests which contain unknown tags');
Exit;
end;