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

domunit.pp:

Browse Source 
+ 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 -
This commit is contained in:
sergei 2009-09-17 09:58:15 +00:00
parent 56e15073bb
commit fc34dc84ff
5 changed files with 463 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

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

13
packages/fcl-xml/tests/README_DOM.txt
View File

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

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

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

123
packages/fcl-xml/tests/extras.pp Normal file
View File

@ -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, sergei_gorelkin@mail.ru
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.

313
packages/fcl-xml/tests/extras2.pp Normal file
View File

@ -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, sergei_gorelkin@mail.ru
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.