* 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.

git-svn-id: trunk@20442 -

packages/fcl-xml/tests/domunit.pp

@@ -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;
 

packages/fcl-xml/tests/extras.pp

@@ -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;
 
 

packages/fcl-xml/tests/extras2.pp

@@ -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

packages/fcl-xml/tests/testgen.pp

@@ -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;