domunit.pp:

+ Added TDOMTestBase.LoadStringData method, allows loading documents from string.
* Don't return empty string from GetResourceURI when file doesn't exist. Thus we can see the problematic filename in the test output.

+ Added extras.pp, contains a few tests not present in w3.org test suite.
+ Added extras2.pp, contains some tests ported by hand because no automatic conversion possible yet. It addresses namespace fixup during serialization and canonical-form issues.

README_DOM.txt: updated to reflect the added units.

git-svn-id: trunk@13729 -

.gitattributes

@@ -1690,6 +1690,8 @@ packages/fcl-xml/tests/README.txt svneol=native#text/plain
 packages/fcl-xml/tests/README_DOM.txt svneol=native#text/plain
 packages/fcl-xml/tests/api.xml svneol=native#text/plain
 packages/fcl-xml/tests/domunit.pp svneol=native#text/plain
+packages/fcl-xml/tests/extras.pp svneol=native#text/plain
+packages/fcl-xml/tests/extras2.pp svneol=native#text/plain
 packages/fcl-xml/tests/template.xml svneol=native#text/plain
 packages/fcl-xml/tests/testgen.pp svneol=native#text/plain
 packages/fcl-xml/tests/xmlts.pp svneol=native#text/plain

packages/fcl-xml/tests/README_DOM.txt

@@ -24,7 +24,11 @@ the following files:
 1) testgen.pp  - an utility for generating Pascal source from XML descriptions.
 2) api.xml     - database used by testgen.
 3) domunit.pp  - FPCUnit extensions required at runtime.
-4) README_DOM.txt - this file.
+4) extras.pp   - Additional tests, not present in w3.org testsuite.
+5) extras2.pp  - Some tests that are present in the testsuite, but converted/modified
+                 by hand because automatic conversion is not yet possible.
+6) README_DOM.txt - this file.
+
 
 To test the FCL DOM implementation, follow these steps:
 
@@ -73,9 +77,10 @@ other elements not yet known to testgen, will be skipped. The conversion may be
 by using -f commandline switch, but in this case the resulting Pascal unit will likely
 fail to compile.
  
-4) Now, pick up your preferred fpcunit test runner, include the generated units into
-its uses clause, and compile. During compilation, path to 'domunit.pp' should be added
-to the unit search paths.
+4) Now, pick up your preferred fpcunit test runner, add the generated units to its
+uses clause, and compile. You may as well add the suppied 'extras.pp' and 'extras2.pp'
+units. During compilation, path to 'domunit.pp' should be added to the unit search
+paths.
 
 5) During runtime, tests must be able to read test files which are located
 within CVS source tree ('files' subdirectory of each module directory). For this purpose,

packages/fcl-xml/tests/domunit.pp

@@ -41,6 +41,7 @@ type
     procedure TearDown; override;
     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 ContentTypeIs(const t: string): Boolean;
     function GetImplementation: TDOMImplementation;
@@ -97,6 +98,7 @@ procedure TDOMTestBase.SetUp;
 begin
   FParser := TDOMParser.Create;
   FParser.Options.PreserveWhitespace := True;
+  //FParser.Options.ExpandEntities := True;
   FAutoFree := TObjectList.Create(True);
 end;
 
@@ -202,8 +204,7 @@ begin
       CheckFile(Base2, Result) then
         Exit;
   end;
-  if not CheckFile(Base, Result) then
-    Result := '';
+  CheckFile(Base, Result);
 end;
 
 function TDOMTestBase.getImplAttr(const name: string): Boolean;
@@ -315,5 +316,18 @@ begin
   result := '';
 end;
 
+procedure TDOMTestBase.LoadStringData(out Doc; const data: string);
+var
+  src: TXMLInputSource;
+begin
+  src := TXMLInputSource.Create(data);
+  try
+    FParser.Parse(src, TXMLDocument(Doc));
+    GC(Doc);
+  finally
+    src.Free;
+  end;
+end;
+
 end.
 

packages/fcl-xml/tests/extras.pp

@@ -0,0 +1,123 @@
+{**********************************************************************
+
+    This file is part of the Free Component Library (FCL)
+
+    DOM Test cases which are missing from w3.org test suite
+    Copyright (c) 2008 by Sergei Gorelkin, [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit extras;
+{$mode objfpc}{$H+}
+interface
+
+uses
+  SysUtils, Classes, DOM, xmlread, domunit, testregistry;
+
+implementation
+
+type
+  TDOMTestExtra = class(TDOMTestBase)
+  published
+    procedure attr_ownership01;
+    procedure attr_ownership02;
+    procedure attr_ownership03;
+    procedure attr_ownership04;
+  end;
+
+{ TDOMTestExtra }
+
+// verify that an attribute created by Element.SetAttribute()
+// has its OwnerElement assigned properly
+procedure TDOMTestExtra.attr_ownership01;
+var
+  doc: TDOMDocument;
+  el: TDOMElement;
+  attr: TDOMAttr;
+  attrOwner: TDOMElement;
+begin
+  LoadStringData(doc, '<doc/>');
+  el := doc.CreateElement('element1');
+  el.SetAttribute('newAttr', 'newValue');
+  attr := el.GetAttributeNode('newAttr');
+  AssertNotNull('attribute', attr);
+  attrOwner := attr.OwnerElement;
+  AssertEquals('ownerElement', el, attrOwner);
+  AssertTrue('specified', attr.Specified);
+end;
+
+// verify that an attribute created by Element.SetAttributeNS()
+// has its OwnerElement assigned properly
+procedure TDOMTestExtra.attr_ownership02;
+var
+  doc: TDOMDocument;
+  el: TDOMElement;
+  attr: TDOMAttr;
+  attrOwner: TDOMElement;
+begin
+  LoadStringData(doc, '<doc/>');
+  el := doc.CreateElement('element1');
+  el.SetAttributeNS('http://www.freepascal.org', 'fpc:newAttr', 'newValue');
+  attr := el.GetAttributeNodeNS('http://www.freepascal.org', 'newAttr');
+  AssertNotNull('attribute', attr);
+  attrOwner := attr.OwnerElement;
+  AssertEquals('ownerElement', el, attrOwner);
+  AssertTrue('specified', attr.Specified);
+end;
+
+// verify that NamedNodeMap.SetNamedItem() resets OwnerElement
+// of the attribute being replaced
+procedure TDOMTestExtra.attr_ownership03;
+var
+  doc: TDOMDocument;
+  el: TDOMElement;
+  attr, attr2: TDOMAttr;
+  retNode: TDOMNode;
+begin
+  LoadStringData(doc, '<doc/>');
+  el := doc.CreateElement('element1');
+  attr := doc.CreateAttribute('newAttr');
+  el.SetAttributeNode(attr);
+  AssertEquals('ownerElement_before', el, attr.OwnerElement);
+  attr2 := doc.CreateAttribute('newAttr');
+  retNode := el.Attributes.SetNamedItem(attr2);
+  AssertSame('retNode', attr, retNode);
+  AssertNull('ownerElement_after', attr.OwnerElement);
+  AssertEquals('ownerElement2', el, attr2.OwnerElement);
+end;
+
+// verify that NamedNodeMap.SetNamedItemNS() resets OwnerElement
+// of the attribute being replaced
+procedure TDOMTestExtra.attr_ownership04;
+var
+  doc: TDOMDocument;
+  el: TDOMElement;
+  attr, attr2: TDOMAttr;
+  retNode: TDOMNode;
+begin
+  LoadStringData(doc, '<doc/>');
+  el := doc.CreateElement('element1');
+  attr := doc.CreateAttributeNS('http://www.freepascal.org', 'fpc:newAttr');
+  el.SetAttributeNodeNS(attr);
+  AssertEquals('ownerElement_before', el, attr.OwnerElement);
+  attr2 := doc.CreateAttributeNS('http://www.freepascal.org', 'fpc:newAttr');
+  retNode := el.Attributes.SetNamedItemNS(attr2);
+  AssertSame('retNode', attr, retNode);
+  AssertNull('ownerElement_after', attr.OwnerElement);
+  AssertEquals('ownerElement2', el, attr2.OwnerElement);
+end;
+
+
+
+
+initialization
+  RegisterTest(TDOMTestExtra);
+
+end.
+

packages/fcl-xml/tests/extras2.pp

@@ -0,0 +1,313 @@
+{**********************************************************************
+
+    This file is part of the Free Component Library (FCL)
+
+    Some DOM test cases adapted by hand (because automatic conversion
+    is not yet possible for them).
+    Copyright (c) 2001-2004 World Wide Web Consortium,
+    (Massachusetts Institute of Technology, Institut National de
+    Recherche en Informatique et en Automatique, Keio University). All
+    Rights Reserved.
+    Copyright (c) 2009 by Sergei Gorelkin, [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit extras2;
+{$mode objfpc}{$H+}
+interface
+
+uses
+  SysUtils, Classes, DOM, xmlread, xmlwrite, domunit, testregistry;
+
+implementation
+
+type
+  TDOMTestExtra2 = class(TDOMTestBase)
+  published
+    procedure ls3_canonicform08;
+    procedure ls3_canonicform09;
+    procedure ls3_canonicform10;
+    procedure ls3_canonicform11;
+    procedure ls3_DomWriterTest5;
+    procedure ls3_DomWriterTest6;
+  end;
+
+const
+// This is example #1 from c14n specs, but modified to comply with HTML grammar
+  canonicform01 =
+'<?xml version="1.0"?>'^M^J+
+^M^J+
+'<?xml-stylesheet   href="doc.xsl"'^M^J+
+'   type="text/xsl"   ?>'^M^J+
+^M^J+
+'<!DOCTYPE html SYSTEM "xhtml1-strict.dtd">'^M^J+
+'<html xmlns="http://www.w3.org/1999/xhtml"><head><title>canonicalform01</title></head><body onload="parent.loadComplete()">'^M^J+
+'<p>Hello, world!<!-- Comment 1 --></p></body></html>'^M^J+
+^M^J+
+'<?pi-without-data     ?>'^M^J+
+^M^J+
+'<!-- Comment 2 -->'^M^J+
+^M^J+
+'<!-- Comment 3 -->'^M^J;
+
+  canonicform03 =
+'<!DOCTYPE html [<!ATTLIST acronym title CDATA "default">]>'^M^J+
+'<html xmlns="http://www.w3.org/1999/xhtml"><head><title>canonicalform03</title></head><body onload="parent.loadComplete()">'^M^J+
+'   <br   />'^M^J+
+'   <br   ></br>'^M^J+
+'   <div   name = "elem3"   id="elem3"   />'^M^J+
+'   <div   name="elem4"   id="elem4"   ></div>'^M^J+
+'   <div a:attr="out" b:attr="sorted" name="all" class="I''m"'^M^J+
+'      xmlns:b="http://www.ietf.org"'^M^J+
+'      xmlns:a="http://www.w3.org"'^M^J+
+'      xmlns="http://example.org"/>'^M^J+
+'   <div xmlns="" xmlns:a="http://www.w3.org">'^M^J+
+'      <div xmlns="http://www.ietf.org">'^M^J+
+'         <div xmlns="" xmlns:a="http://www.w3.org">'^M^J+
+'            <acronym xmlns="" xmlns:a="http://www.ietf.org"/>'^M^J+
+'         </div>'^M^J+
+'      </div>'^M^J+
+'   </div>'^M^J+
+'</body></html>'^M^J;
+
+{ TDOMTestExtra }
+
+{ test canonical form with comments }
+procedure TDOMTestExtra2.ls3_canonicform08;
+var
+  doc: TDOMDocument;
+  node: TDOMNode;
+  nodeType: Integer;
+  nodeValue: DOMString;
+  length: Integer;
+begin
+// canonical form: PreserveWhitespace, Namespaces, NamespaceDeclarations = True;
+//                 Entities, CDSections = False;
+  FParser.Options.PreserveWhitespace := True;
+  FParser.Options.Namespaces := True;
+  LoadStringData(doc, canonicform01);
+  begin
+    node := TDOMNode(doc).firstChild;
+    nodeType := node.nodeType;
+    assertEquals('PIisFirstChild', 7, nodeType);
+    nodeValue := TDOMProcessingInstruction(node).data;
+    length := system.length(nodeValue);
+    assertEquals('piDataLength', 36, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisSecondChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('secondChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('ElementisThirdChild', 1, nodeType);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisFourthChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('fourthChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('PIisFifthChild', 7, nodeType);
+    nodeValue := TDOMProcessingInstruction(node).data;
+    assertEquals('trailingPIData', '', nodeValue);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisSixthChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('sixthChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('CommentisSeventhChild', 8, nodeType);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisEighthChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('eighthChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('CommentisNinthChild', 8, nodeType);
+    node := node.nextSibling;
+    assertNull('TenthIsNull', node);
+  end;
+end;
+
+{ test canonical form without comments }
+procedure TDOMTestExtra2.ls3_canonicform09;
+var
+  doc: TDOMDocument;
+  node: TDOMNode;
+  nodeType: Integer;
+  nodeValue: DOMString;
+  length: Integer;
+begin
+// canonical form: PreserveWhitespace, Namespaces, NamespaceDeclarations = True;
+//                 Entities, CDSections = False;
+  FParser.Options.PreserveWhitespace := True;
+  FParser.Options.Namespaces := True;
+  FParser.Options.IgnoreComments := True;
+  LoadStringData(doc, canonicform01);
+  begin
+    node := TDOMNode(doc).firstChild;
+    nodeType := node.nodeType;
+    assertEquals('PIisFirstChild', 7, nodeType);
+    nodeValue := TDOMProcessingInstruction(node).data;
+    length := system.length(nodeValue);
+    assertEquals('piDataLength', 36, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisSecondChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('secondChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('ElementisThirdChild', 1, nodeType);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('TextisFourthChild', 3, nodeType);
+    nodeValue := node.nodeValue;
+    length := system.length(nodeValue);
+    assertEquals('fourthChildLength', 1, length);
+    node := node.nextSibling;
+    nodeType := node.nodeType;
+    assertEquals('PIisFifthChild', 7, nodeType);
+    nodeValue := TDOMProcessingInstruction(node).data;
+    assertEquals('trailingPIData', '', nodeValue);
+    node := node.nextSibling;
+    assertNull('SixthIsNull', node);
+  end;
+end;
+
+{ test removal of superfluous namespace declarations }
+procedure TDOMTestExtra2.ls3_canonicform10;
+var
+  doc: TDOMDocument;
+  divList: TDOMNodeList;
+  divEl: TDOMElement;
+  node: TDOMNode;
+begin
+  FParser.Options.PreserveWhitespace := True;
+  FParser.Options.Namespaces := True;
+  LoadStringData(doc, canonicform03);
+
+  divList := doc.getElementsByTagName('div');
+  TDOMNode(divEl) := divList[5];
+  node := divEl.getAttributeNode('xmlns');
+  assertNotNull('xmlnsPresent', node);
+  node := divEl.getAttributeNode('xmlns:a');
+  assertNull('xmlnsANotPresent', node);
+end;
+
+{ test that defaulted attributes are being replaced by 'normal' ones }
+procedure TDOMTestExtra2.ls3_canonicform11;
+var
+  doc: TDOMDocument;
+  elemList: TDOMNodeList;
+  elem: TDOMElement;
+  attr: TDOMAttr;
+  attrSpecified: Boolean;
+  attrValue: DOMString;
+begin
+  FParser.Options.PreserveWhitespace := True;
+  FParser.Options.Namespaces := True;
+  LoadStringData(doc, canonicform03);
+
+  elemList := doc.getElementsByTagName('acronym');
+  TDOMNode(elem) := elemList[0];
+  attr := elem.getAttributeNode('title');
+  assertNotNull('titlePresent', attr);
+  attrSpecified := attr.specified;
+  assertTrue('titleSpecified', attrSpecified);
+  attrValue := attr.nodeValue;
+  assertEquals('titleValue', 'default', attrValue);
+end;
+
+{ tests that namespace fixup is done while serializing }
+{ attribute has no prefix }
+procedure TDOMTestExtra2.ls3_DomWriterTest5;
+var
+  domImpl: TDOMImplementation;
+  origDoc: TDOMDocument;
+  parsedDoc: TDOMDocument;
+  docElem: TDOMElement;
+  stream: TStringStream;
+  docElemLocalName: DOMString;
+  docElemNS: DOMString;
+  attrValue: DOMString;
+const
+  namespaceURI = 'http://www.example.com/DOMWriterTest5';
+begin
+  FParser.Options.Namespaces := True;
+  domImpl := GetImplementation;
+  origDoc := domImpl.createDocument(namespaceURI, 'test', nil);
+  docElem := origDoc.documentElement;
+  docElem.setAttributeNS(namespaceURI, 'attr', 'test value');
+
+  stream := TStringStream.Create('');
+  GC(stream);
+  writeXML(origDoc, stream);
+
+  LoadStringData(parsedDoc, stream.DataString);
+
+  docElem := parsedDoc.documentElement;
+  docElemLocalName := docElem.localName;
+  assertEquals('docElemLocalName', 'test', docElemLocalName);
+  docElemNS := TDOMNode(docElem).namespaceURI;
+  assertEquals('docElemNS', namespaceURI, docElemNS);
+  attrValue := docElem.getAttributeNS(namespaceURI, 'attr');
+  assertEquals('properNSAttrValue', 'test value', attrValue);
+end;
+
+{ tests that namespace fixup is done while serializing }
+{ same as above, but using an attribute that has a prefix }
+procedure TDOMTestExtra2.ls3_DomWriterTest6;
+var
+  domImpl: TDOMImplementation;
+  origDoc: TDOMDocument;
+  parsedDoc: TDOMDocument;
+  docElem: TDOMElement;
+  stream: TStringStream;
+  docElemLocalName: DOMString;
+  docElemNS: DOMString;
+  attrValue: DOMString;
+const
+  namespaceURI = 'http://www.example.com/DOMWriterTest5';
+begin
+  FParser.Options.Namespaces := True;
+  domImpl := GetImplementation;
+  origDoc := domImpl.createDocument(namespaceURI, 'test', nil);
+  docElem := origDoc.documentElement;
+  docElem.setAttributeNS(namespaceURI, 'test:attr', 'test value');
+
+  stream := TStringStream.Create('');
+  GC(stream);
+  writeXML(origDoc, stream);
+
+  LoadStringData(parsedDoc, stream.DataString);
+
+  docElem := parsedDoc.documentElement;
+  docElemLocalName := docElem.localName;
+  assertEquals('docElemLocalName', 'test', docElemLocalName);
+  docElemNS := TDOMNode(docElem).namespaceURI;
+  assertEquals('docElemNS', namespaceURI, docElemNS);
+  attrValue := docElem.getAttributeNS(namespaceURI, 'attr');
+  assertEquals('properNSAttrValue', 'test value', attrValue);
+end;
+
+initialization
+  RegisterTest(TDOMTestExtra2);
+
+end.
+