* Patch from Sergei Gorelkin

  + DTD validation
  + Correct reporting of the position of most fatal errors
  + TDOMDocument.CreateElement and others check their arguments for validity
    (INVALID_CHARACTER_ERR is reported where specification says)
  + property TDOMAttr.DataType
  + implemented TDOMDocument.GetElementByID
  * Common code moved to xmlutils.pp
  * whitespace in PublicID literals is normalized

git-svn-id: trunk@6749 -

.gitattributes

@@ -4252,8 +4252,10 @@ packages/fcl-xml/src/xhtml.pp svneol=native#text/plain
 packages/fcl-xml/src/xmlcfg.pp svneol=native#text/plain
 packages/fcl-xml/src/xmlread.pp svneol=native#text/plain
 packages/fcl-xml/src/xmlstreaming.pp svneol=native#text/plain
+packages/fcl-xml/src/xmlutils.pp svneol=native#text/plain
 packages/fcl-xml/src/xmlwrite.pp svneol=native#text/plain
 packages/fcl-xml/src/xpath.pp svneol=native#text/plain
+packages/fcl-xml/tests/xmlts.pp svneol=native#text/plain
 packages/fpmake.pp svneol=native#text/plain
 rtl/COPYING -text
 rtl/COPYING.FPC -text

packages/fcl-xml/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/03/04]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/03/08]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
@@ -233,160 +233,160 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=fcl-xml
 override PACKAGE_VERSION=2.0.0
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+override TARGET_UNITS+=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=sax xpath

packages/fcl-xml/Makefile.fpc

@@ -7,7 +7,7 @@ name=fcl-xml
 version=2.0.0
 
 [target]
-units=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
+units=sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath
 rsts=sax xpath
 
 [require]

packages/fcl-xml/src/dom.pp

@@ -109,8 +109,10 @@ type
 //   DOMString
 // -------------------------------------------------------
 
+  TSetOfChar = set of Char;
   DOMString = WideString;
   DOMPChar = PWideChar;
+  PDOMString = ^DOMString;
 
   EDOMError = class(Exception)
   public
@@ -205,6 +207,8 @@ type
     function GetNodeType: Integer; virtual; abstract;
     function GetTextContent: DOMString; virtual;
     procedure SetTextContent(const AValue: DOMString); virtual;
+    function GetLocalName: DOMString; virtual;
+    function GetNamespaceURI: DOMString; virtual;
   public
     constructor Create(AOwner: TDOMDocument);
     destructor Destroy; override;
@@ -239,15 +243,13 @@ type
     function HasAttributes: Boolean; virtual;
     procedure Normalize;
 
-    (*
-    // TODO: What is that Java NULL for strings ???
     // always '' for nodes other than ELEMENT and ATTRIBUTE
     // as well as for nodes created with DOM 1 methods
-    property NamespaceURI: DOMString read GetNamespaceURI;
-
+    //property NamespaceURI: DOMString read GetNamespaceURI;
+    //property LocalName: DOMString read GetLocalName;
+    (*
     // Prefix may only be changed if it was specified at creation time.
     property Prefix: DOMString read FPrefix (write SetPrefix?);
-    property LocalName: DOMString read FLocalName;
     *)
     // DOM level 3
     property TextContent: DOMString read GetTextContent write SetTextContent;
@@ -406,12 +408,17 @@ type
 
   TDOMDocument = class(TDOMNode_WithChildren)
   protected
+    FIDList: TList;
     FRevision: Integer;
+    FXML11: Boolean;
     FImplementation: TDOMImplementation;
     function GetDocumentElement: TDOMElement;
     function GetDocType: TDOMDocumentType;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
+    function IndexOfNS(const nsURI: DOMString): Integer;
+    function FindID(const aID: DOMString; out Index: LongWord): Boolean;
+    procedure ClearIDList;
   public
     property DocType: TDOMDocumentType read GetDocType;
     property Impl: TDOMImplementation read FImplementation;
@@ -444,17 +451,24 @@ type
     // Extensions to DOM interface:
     // TODO: obsolete now, but must check for usage dependencies
     constructor Create;
+    destructor Destroy; override;
+    function AddID(Attr: TDOMAttr): Boolean;
+    procedure RemoveID(Attr: TDOMAttr);
   end;
 
   TXMLDocument = class(TDOMDocument)
+  private
+    FXMLVersion: DOMString;
+    procedure SetXMLVersion(const aValue: DOMString);
   public
     // These fields are extensions to the DOM interface:
-    XMLVersion, Encoding, StylesheetType, StylesheetHRef: DOMString;
+    Encoding, StylesheetType, StylesheetHRef: DOMString;
 
     function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
     function CreateProcessingInstruction(const target, data: DOMString):
       TDOMProcessingInstruction; override;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
+    property XMLVersion: DOMString read FXMLVersion write SetXMLVersion;
   end;
 
 
@@ -462,12 +476,27 @@ type
 //   Attr
 // -------------------------------------------------------
 
+  TAttrDataType = (
+    dtCdata,
+    dtId,
+    dtIdRef,
+    dtIdRefs,
+    dtEntity,
+    dtEntities,
+    dtNmToken,
+    dtNmTokens,
+    dtNotation
+  );
+
   TDOMAttr = class(TDOMNode_WithChildren)
   protected
     FName: DOMString;
-    FSpecified: Boolean;
-    FNormalize: Boolean;
     FOwnerElement: TDOMElement;
+    // TODO: following 3 - replace with a link to AttDecl ??
+    // ('specified' isn't related...)
+    FSpecified: Boolean;
+    FDeclared: Boolean;
+    FDataType: TAttrDataType;
     function  GetNodeValue: DOMString; override;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
@@ -477,10 +506,10 @@ type
     property Name: DOMString read FName;
     property Specified: Boolean read FSpecified;
     property Value: DOMString read GetNodeValue write SetNodeValue;
-    // Introduced in DOM level 2:
     property OwnerElement: TDOMElement read FOwnerElement;
     // extensions
     function CompareName(const AName: DOMString): Integer; override;
+    property DataType: TAttrDataType read FDataType;
   end;
 
 
@@ -532,11 +561,16 @@ type
 
   TDOMText = class(TDOMCharacterData)
   protected
+    // set by parser if text contains only literal whitespace (i.e. not coming from CharRefs) 
+    FMayBeIgnorable: Boolean;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
+    procedure SetNodeValue(const aValue: DOMString); override;
   public
     function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     function SplitText(offset: LongWord): TDOMText;
+    // Extension
+    property MayBeIgnorable: Boolean read FMayBeIgnorable write FMayBeIgnorable;
   end;
 
 
@@ -577,10 +611,12 @@ type
     FSystemID: DOMString;
     FInternalSubset: DOMString;
     FEntities, FNotations: TDOMNamedNodeMap;
+    FElementDefs: TDOMNamedNodeMap;
     function GetEntities: TDOMNamedNodeMap;
     function GetNotations: TDOMNamedNodeMap;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
+    function GetElementDefs: TDOMNamedNodeMap;
   public
     destructor Destroy; override;
     function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
@@ -591,6 +627,8 @@ type
     property PublicID: DOMString read FPublicID;
     property SystemID: DOMString read FSystemID;
     property InternalSubset: DOMString read FInternalSubset;
+    // extensions
+    property ElementDefs: TDOMNamedNodeMap read GetElementDefs;
   end;
 
 
@@ -669,6 +707,15 @@ type
 
 implementation
 
+uses
+  xmlutils;
+
+type
+  PIDItem = ^TIDItem;
+  TIDItem = record
+    ID: WideString;
+    Element: TDOMElement;
+  end;
 
 constructor TRefClass.Create;
 begin
@@ -881,7 +928,8 @@ begin
       if Assigned(Txt) then
       begin
         tmp := Child.NextSibling;
-        Txt.AppendData(Child.nodeValue);
+        Txt.AppendData(TDOMText(Child).Data);
+        Txt.FMayBeIgnorable := Txt.FMayBeIgnorable and TDOMText(Child).FMayBeIgnorable;
         RemoveChild(Child);
         Child := tmp;
       end
@@ -910,6 +958,16 @@ begin
   NodeValue := AValue;
 end;
 
+function TDOMNode.GetNamespaceURI: DOMString;
+begin
+  Result := '';
+end;
+
+function TDOMNode.GetLocalName: DOMString;
+begin
+  Result := '';
+end;
+
 function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
 var i: integer;
 begin
@@ -935,16 +993,12 @@ end;
 
 function CompareDOMNodeWithDOMNode(Node1, Node2: Pointer): integer;
 begin
-  Result:=CompareDOMStrings(DOMPChar(TDOMNode(Node1).NodeName),
-                            DOMPChar(TDOMNode(Node2).NodeName),
-                            length(TDOMNode(Node1).NodeName),
-                            length(TDOMNode(Node2).NodeName)
-                            );
+  Result := TDOMNode(Node1).CompareName(TDOMNode(Node2).NodeName);
 end;
 
 function CompareDOMStringWithDOMNode(AKey, ANode: Pointer): integer;
 begin
-  Result := TDOMNode(ANode).CompareName(DOMString(AKey));
+  Result := TDOMNode(ANode).CompareName(PDOMString(AKey)^);
 end;
 
 
@@ -1047,14 +1101,11 @@ end;
 function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
   TDOMNode;
 begin
-//  Inc(FOwnerDocument.FRevision); // invalidate nodelists (will happen anyway)
-
   RemoveFromChildNodeTree(OldChild);
   InsertBefore(NewChild, OldChild);
   if Assigned(OldChild) then
     RemoveChild(OldChild);
-  // TODO: must return OldChild, if I understand that right...
-  // but OldChild is destroyed!
+  // TODO: per DOM spec, must return OldChild, but OldChild is destroyed
   Result := NewChild;
 end;
 
@@ -1167,7 +1218,7 @@ var AVLNode: TAVLTreeNode;
 begin
   Result:=nil;
   if FChildNodeTree<>nil then begin
-    AVLNode:=FChildNodeTree.FindKey(DOMPChar(ANodeName),
+    AVLNode:=FChildNodeTree.FindKey(Pointer(ANodeName),
                                     @CompareDOMStringWithDOMNode);
     if AVLNode<>nil then
       Result:=TDOMNode(AVLNode.Data);
@@ -1289,7 +1340,7 @@ begin
     BuildList;
 
   if index < LongWord(FList.Count) then
-    Result := TDOMNode(FList[index])
+    Result := TDOMNode(FList.List^[index])
   else
     Result := nil;
 end;
@@ -1618,6 +1669,77 @@ begin
   inherited Create(nil);
   // TODO: DOM lvl 2 states that Document should be unowned. Any dependencies?
   FOwnerDocument := Self;
+  FIDList := TList.Create;
+end;
+
+destructor TDOMDocument.Destroy;
+begin
+  ClearIDList;
+  FIDList.Free;
+  inherited Destroy;
+end;
+
+function TDOMDocument.AddID(Attr: TDOMAttr): Boolean;
+var
+  I: Cardinal;
+  Item: PIDItem;
+begin
+  New(Item);
+  Item^.ID := Attr.Value;
+  Item^.Element := Attr.OwnerElement;
+  if not FindID(Item^.ID, I) then
+  begin
+    FIDList.Insert(I, Item);
+    Result := True;
+  end
+  else
+  begin
+    Dispose(Item);
+    Result := False;
+  end;
+end;
+
+procedure TDOMDocument.RemoveID(Attr: TDOMAttr);
+begin
+  // TODO: Implement this
+end;
+
+function TDOMDocument.FindID(const aID: DOMString; out Index: LongWord): Boolean;
+var
+  L, H, I, C: Integer;
+  P: PIDItem;
+begin
+  Result := False;
+  L := 0;
+  H := FIDList.Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    P := PIDItem(FIDList.List^[I]);
+    C := CompareDOMStrings(PWideChar(aID), PWideChar(P^.ID), Length(aID), Length(P^.ID));
+    if C > 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+procedure TDOMDocument.ClearIDList;
+var
+  I: Integer;
+begin
+  if Assigned(FIDList) then
+  begin
+    for I := 0 to FIDList.Count-1 do
+      Dispose(PIDItem(FIDList.List^[I]));
+    FIDList.Clear;
+  end;    
 end;
 
 function TDOMDocument.GetNodeType: Integer;
@@ -1652,6 +1774,8 @@ end;
 
 function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
 begin
+  if not IsXmlName(tagName, FXML11) then
+    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement');
   Result := TDOMElement.Create(Self);
   Result.FNodeName := tagName;
   // TODO: attach default attributes
@@ -1710,6 +1834,8 @@ end;
 
 function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
 begin
+  if not IsXmlName(name, FXML11) then
+    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute');
   Result := TDOMAttr.Create(Self);
   Result.FName := name;
 end;
@@ -1718,6 +1844,7 @@ function TDOMDocument.CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAt
 begin
   Result := TDOMAttr.Create(Self);
   SetString(Result.FName, Buf, Length);
+  Result.FSpecified := True;
 end;
 
 function TDOMDocument.CreateEntityReference(const name: DOMString):
@@ -1753,13 +1880,15 @@ begin
   Result := nil;
 end;
 
-function TDOMDocument.GetElementById(
-  const ElementID: DOMString): TDOMElement;
+function TDOMDocument.GetElementById(const ElementID: DOMString): TDOMElement;
+var
+  I: Cardinal;
 begin
   // TODO: Implement TDOMDocument.GetElementById
-  // "Implementations that do not know whether attributes are
-  // of type ID or not are expected to return null"
-  Result := nil;
+  if FindID(ElementID, I) then
+    Result := PIDItem(FIDList.List^[I])^.Element
+  else
+    Result := nil;
 end;
 
 function TDOMDocument.ImportNode(ImportedNode: TDOMNode;
@@ -1770,6 +1899,12 @@ begin
   Result := nil;
 end;
 
+function TDOMDocument.IndexOfNS(const nsURI: DOMString): Integer;
+begin
+  // TODO: implement
+  Result := -1;
+end;
+
 
 function TXMLDocument.CreateCDATASection(const data: DOMString):
   TDOMCDATASection;
@@ -1781,6 +1916,8 @@ end;
 function TXMLDocument.CreateProcessingInstruction(const target,
   data: DOMString): TDOMProcessingInstruction;
 begin
+  if not IsXmlName(target, FXML11) then
+    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction');
   Result := TDOMProcessingInstruction.Create(Self);
   Result.FTarget := target;
   Result.FNodeValue := data;
@@ -1789,10 +1926,17 @@ end;
 function TXMLDocument.CreateEntityReference(const name: DOMString):
   TDOMEntityReference;
 begin
+  if not IsXmlName(name, FXML11) then
+    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
   Result := TDOMEntityReference.Create(Self);
   Result.FName := name;
 end;
 
+procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
+begin
+  FXMLVersion := aValue;
+  FXML11 := (aValue = '1.1');
+end;
 
 // -------------------------------------------------------
 //   Attr
@@ -1813,31 +1957,16 @@ begin
   // Cloned attribute is always specified and carries its children
   Result := ACloneOwner.CreateAttribute(FName);
   TDOMAttr(Result).FSpecified := True;
-  TDOMAttr(Result).FNormalize := FNormalize;
+  TDOMAttr(Result).FDataType := FDataType;
+  // Declared = ?
   CloneChildren(Result, ACloneOwner);
 end;
 
 function TDOMAttr.GetNodeValue: DOMString;
-var
-  I,J: Integer;
 begin
   Result := GetTextContent;
-  // TODO: probably must be speed optimized
-  if FNormalize then
-  begin
-    Result := Trim(Result);
-    I := 1;
-    while I < Length(Result) do
-    begin
-      if Result[I] = #32 then
-      begin
-        J := I+1;
-        while (J <= Length(Result)) and (Result[J] = #32) do Inc(J);
-        if J-I > 1 then Delete(Result, I+1, J-I-1);
-      end;
-      Inc(I);
-    end;
-  end;
+  if FDataType <> dtCdata then
+    NormalizeSpaces(Result);
 end;
 
 procedure TDOMAttr.SetNodeValue(const AValue: DOMString);
@@ -1945,7 +2074,7 @@ procedure TDOMElement.RemoveAttributeNS(const namespaceURI,
   localName: DOMString);
 begin
   // TODO: Implement TDOMElement.RemoveAttributeNS
-  raise EDOMNotSupported.Create('TDOMElement.RemoveAttributeNS'); 
+  raise EDOMNotSupported.Create('TDOMElement.RemoveAttributeNS');
 end;
 
 procedure TDOMElement.SetAttributeNS(const namespaceURI, qualifiedName,
@@ -2057,9 +2186,17 @@ begin
   Result := '#text';
 end;
 
+procedure TDOMText.SetNodeValue(const aValue: DOMString);
+begin
+  // TODO: may analyze aValue, but this will slow things down...
+  FMayBeIgnorable := False;
+  FNodeValue := aValue;
+end;
+
 function TDOMText.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
 begin
   Result := ACloneOwner.CreateTextNode(FNodeValue);
+  TDOMText(Result).FMayBeIgnorable := FMayBeIgnorable;
 end;
 
 function TDOMText.SplitText(offset: LongWord): TDOMText;
@@ -2069,6 +2206,7 @@ begin
 
   Result := TDOMText.Create(FOwnerDocument);
   Result.FNodeValue := Copy(FNodeValue, offset + 1, Length);
+  Result.FMayBeIgnorable := FMayBeIgnorable;
   FNodeValue := Copy(FNodeValue, 1, offset);
   FParentNode.InsertBefore(Result, FNextSibling);
 end;
@@ -2132,6 +2270,7 @@ destructor TDOMDocumentType.Destroy;
 begin
   FEntities.Free;
   FNotations.Free;
+  FElementDefs.Free;
   inherited Destroy;
 end;
 
@@ -2159,6 +2298,13 @@ begin
   Result := FNotations;
 end;
 
+function TDOMDocumentType.GetElementDefs: TDOMNamedNodeMap;
+begin
+  if FElementDefs = nil then
+    FElementDefs := TDOMNamedNodeMap.Create(Self, ELEMENT_NODE);
+  Result := FElementDefs;
+end;
+
 // -------------------------------------------------------
 //   Notation
 // -------------------------------------------------------

packages/fcl-xml/src/sax_html.pp

@@ -29,7 +29,7 @@ unit SAX_HTML;
 
 interface
 
-uses SysUtils, Classes, SAX, DOM, DOM_HTML;
+uses SysUtils, Classes, SAX, DOM, DOM_HTML,htmldefs;
 
 type
 
@@ -111,7 +111,6 @@ procedure ReadHTMLFragment(AParentNode: TDOMNode; var f: TStream);
 
 implementation
 
-uses HTMLDefs;
 
 const
   WhitespaceChars = [#9, #10, #13, ' '];

packages/fcl-xml/src/xmlutils.pp

@@ -0,0 +1,222 @@
+{
+    This file is part of the Free Component Library
+
+    XML utility routines.
+    Copyright (c) 2006 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 xmlutils;
+
+interface
+
+uses
+  SysUtils;
+
+function IsXmlName(const Value: WideString; Xml11: Boolean = False): Boolean;
+function IsXmlNames(const Value: WideString; Xml11: Boolean = False): Boolean;
+function IsXmlNmToken(const Value: WideString; Xml11: Boolean = False): Boolean;
+function IsXmlNmTokens(const Value: WideString; Xml11: Boolean = False): Boolean;
+function IsValidXmlEncoding(const Value: WideString): Boolean;
+function Xml11NamePages: PByteArray;
+procedure NormalizeSpaces(var Value: WideString);
+
+{$i names.inc}
+
+implementation
+
+var
+  Xml11Pg: PByteArray = nil;
+
+function Xml11NamePages: PByteArray;
+var
+  I: Integer;
+  p: PByteArray;
+begin
+  if Xml11Pg = nil then
+  begin
+    GetMem(p, 512);
+    for I := 0 to 255 do
+      p^[I] := ord(Byte(I) in Xml11HighPages);
+    p^[0] := 2;
+    p^[3] := $2c;
+    p^[$20] := $2a;
+    p^[$21] := $2b;
+    p^[$2f] := $29;
+    p^[$30] := $2d;
+    p^[$fd] := $28;
+
+    Move(p^, p^[256], 256);
+    p^[$100] := $19;
+    p^[$103] := $2E;
+    p^[$120] := $2F;
+    Xml11Pg := p;
+  end;
+  Result := Xml11Pg;
+end;
+
+function IsXml11Char(const Value: WideString; var Index: Integer): Boolean;
+begin
+  if (Value[Index] >= #$D800) and (Value[Index] <= #$DB7F) then
+  begin
+    Inc(Index);
+    Result := (Value[Index] >= #$DC00) and (Value[Index] <= #$DFFF);
+  end
+  else
+    Result := False;
+end;
+
+function IsXmlName(const Value: WideString; Xml11: Boolean): Boolean;
+var
+  Pages: PByteArray;
+  I: Integer;
+begin
+  Result := False;
+  if Xml11 then
+    Pages := Xml11NamePages
+  else
+    Pages := @NamePages;
+
+  I := 1;
+  if (Value = '') or not ((Byte(Value[I]) in NamingBitmap[Pages^[hi(Word(Value[I]))]]) or
+    (Xml11 and IsXml11Char(Value, I))) then
+      Exit;
+  Inc(I);
+  while I <= Length(Value) do
+  begin
+    if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or
+      (Xml11 and IsXml11Char(Value, I))) then
+        Exit;
+    Inc(I);
+  end;
+  Result := True;
+end;
+
+function IsXmlNames(const Value: WideString; Xml11: Boolean): Boolean;
+var
+  Pages: PByteArray;
+  I: Integer;
+  Offset: Integer;
+begin
+  if Xml11 then
+    Pages := Xml11NamePages
+  else
+    Pages := @NamePages;
+  Result := False;
+  if Value = '' then
+    Exit;
+  I := 1;
+  Offset := 0;
+  while I <= Length(Value) do
+  begin
+    if not ((Byte(Value[I]) in NamingBitmap[Pages^[Offset+hi(Word(Value[I]))]]) or
+      (Xml11 and IsXml11Char(Value, I))) then
+    begin
+      if (I = Length(Value)) or (Value[I] <> #32) then
+        Exit;
+      Offset := 0;
+      Inc(I);
+      Continue;
+    end;
+    Offset := $100;
+    Inc(I);
+  end;
+  Result := True;
+end;
+
+function IsXmlNmToken(const Value: WideString; Xml11: Boolean): Boolean;
+var
+  I: Integer;
+  Pages: PByteArray;
+begin
+  if Xml11 then
+    Pages := Xml11NamePages
+  else
+    Pages := @NamePages;
+  Result := False;
+  if Value = '' then
+    Exit;
+  I := 1;
+  while I <= Length(Value) do
+  begin
+    if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or
+      (Xml11 and IsXml11Char(Value, I))) then
+        Exit;
+    Inc(I);
+  end;
+  Result := True;
+end;
+
+function IsXmlNmTokens(const Value: WideString; Xml11: Boolean): Boolean;
+var
+  I: Integer;
+  Pages: PByteArray;
+begin
+  if Xml11 then
+    Pages := Xml11NamePages
+  else
+    Pages := @NamePages;
+  I := 1;
+  Result := False;
+  if Value = '' then
+    Exit;
+  while I <= Length(Value) do
+  begin
+    if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or
+      (Xml11 and IsXml11Char(Value, I))) then
+    begin
+      if (I = Length(Value)) or (Value[I] <> #32) then
+        Exit;
+    end;
+    Inc(I);
+  end;
+  Result := True;
+end;
+
+function IsValidXmlEncoding(const Value: WideString): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  if (Value = '') or (Value[1] > #255) or not (char(Value[1]) in ['A'..'Z', 'a'..'z']) then
+    Exit;
+  for I := 2 to Length(Value) do
+    if (Value[I] > #255) or not (char(Value[I]) in ['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']) then
+      Exit;
+  Result := True;
+end;
+
+procedure NormalizeSpaces(var Value: WideString);
+var
+  I, J: Integer;
+begin
+  I := Length(Value);
+  // speed: trim only whed needed
+  if (I > 0) and ((Value[1] = #32) or (Value[I] = #32)) then
+    Value := Trim(Value);
+  I := 1;
+  while I < Length(Value) do
+  begin
+    if Value[I] = #32 then
+    begin
+      J := I+1;
+      while (J <= Length(Value)) and (Value[J] = #32) do Inc(J);
+      if J-I > 1 then Delete(Value, I+1, J-I-1);
+    end;
+    Inc(I);
+  end;
+end;
+
+initialization
+
+finalization
+  if Assigned(Xml11Pg) then
+    FreeMem(Xml11Pg);
+
+end.

packages/fcl-xml/src/xmlwrite.pp

@@ -44,7 +44,6 @@ implementation
 uses SysUtils;
 
 type
-  TCharacters = set of Char;
   TSpecialCharCallback = procedure(c: WideChar) of object;
 
   TXMLWriter = class(TObject)
@@ -64,7 +63,7 @@ type
     procedure wrtLineEnd; {$IFDEF HAS_INLINE} inline; {$ENDIF}
     procedure wrtIndent; {$IFDEF HAS_INLINE} inline; {$ENDIF}
     procedure wrtQuotedLiteral(const ws: WideString);
-    procedure ConvWrite(const s: WideString; const SpecialChars: TCharacters;
+    procedure ConvWrite(const s: WideString; const SpecialChars: TSetOfChar;
       const SpecialCharCallback: TSpecialCharCallback);
     procedure AttrSpecialCharCallback(c: WideChar);
     procedure TextNodeSpecialCharCallback(c: WideChar);
@@ -297,7 +296,7 @@ const
   AttrSpecialChars = ['<', '"', '&', #9, #10, #13];
   TextSpecialChars = ['<', '>', '&'];
 
-procedure TXMLWriter.ConvWrite(const s: WideString; const SpecialChars: TCharacters;
+procedure TXMLWriter.ConvWrite(const s: WideString; const SpecialChars: TSetOfChar;
   const SpecialCharCallback: TSpecialCharCallback);
 var
   StartPos, EndPos: Integer;
@@ -362,6 +361,7 @@ begin
     COMMENT_NODE:                VisitComment(node);
     DOCUMENT_NODE:               VisitDocument(node);
     DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
+    ENTITY_NODE,
     DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
   end;
 end;
@@ -384,7 +384,8 @@ begin
     for i := 0 to node.Attributes.Length - 1 do
     begin
       attr := node.Attributes.Item[i];
-      VisitAttribute(attr);
+      if TDOMAttr(attr).Specified then
+        VisitAttribute(attr);
     end;
   Child := node.FirstChild;
   if Child = nil then
@@ -532,18 +533,19 @@ procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
 begin
   wrtStr('<!DOCTYPE ');
   wrtStr(Node.NodeName);
+  wrtChr(' ');
   with TDOMDocumentType(Node) do
   begin
     if PublicID <> '' then
     begin
-      wrtStr(' PUBLIC ');
+      wrtStr('PUBLIC ');
       wrtQuotedLiteral(PublicID);
       wrtChr(' ');
       wrtQuotedLiteral(SystemID);
     end
     else if SystemID <> '' then
     begin
-      wrtStr(' SYSTEM ');
+      wrtStr('SYSTEM ');
       wrtQuotedLiteral(SystemID);
     end;
     if InternalSubset <> '' then
@@ -560,6 +562,7 @@ procedure TXMLWriter.VisitFragment(Node: TDOMNode);
 var
   Child: TDOMNode;
 begin
+  // TODO: TextDecl is probably needed
   // Fragment itself should not be written, only its children should...
   Child := Node.FirstChild;
   while Assigned(Child) do

packages/fcl-xml/tests/xmlts.pp

@@ -0,0 +1,778 @@
+{
+    This file is part of the Free Component Library (FCL)
+
+    FCL test runner for OASIS/NIST XML test suite
+    It is somewhat based on 'harness.js' script
+    (see http://xmlconf.sourceforge.net)
+    Copyright (c) 2006 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.
+
+ **********************************************************************}
+
+program xmlts;
+
+{$IFDEF FPC}
+{$MODE OBJFPC}{$H+}
+{$ENDIF}
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  Classes,
+  DOM,
+  XMLRead,
+  XMLWrite,
+  UriParser;
+
+const
+  harness = 'Pascal version';
+  version = '0.0.1 alpha :)';
+  parser = 'FCL XML parser';
+  parserName = parser;
+  os = 'Unknown OS';
+  runtime = 'FPC RTL';
+
+
+type
+  TDiagCategory = (dcInfo, dcNegfail, dcFail, dcPass);
+
+  TTestSuite = class
+  private
+    FTemplate: TXMLDocument;
+    FParser: TDOMParser;
+    FPassed, FFailCount: Integer;
+    FFalsePasses: Integer;
+    FRootUri: string;
+    FTemplateName: string;
+    FSuiteName: string;
+    FDoc: TXMLDocument;
+    FValidating: Boolean;
+    FSuiteTitle: DOMString;
+    FState: DOMString;
+    FSkipped: Integer;
+    FTotal: Integer;
+    table_valid: TDOMNode;
+    table_output: TDOMNode;
+    table_invalid: TDOMNode;
+    table_not_wf: TDOMNode;
+    table_informative: TDOMNode;
+    FValError: string;
+    FTestID: DOMString;
+    procedure LoadTemplate(const Name: string);
+    procedure HandleTemplatePIs(Element: TDOMNode);
+    procedure Diagnose(Element, Table: TDOMNode; Category: TDiagCategory; const Error: DOMString);
+    procedure DiagnoseOut(const ErrorMsg: DOMString);
+    function CompareNodes(actual, correct: TDOMNode; out Msg: string): Boolean;
+    procedure Canonicalize(node: TDOMNode);
+    procedure ErrorHandler(Error: EXMLReadError);
+  public
+    constructor Create;
+    procedure Run(const Tests: string);
+    procedure RunTest(Element: TDOMElement);
+    destructor Destroy; override;
+  end;
+
+function GetBaseURI(Element: TDOMNode; const DocumentURI: string): string;
+var
+  Ent: TDOMNode;
+  Uri1, Uri2, s: WideString;
+begin
+  case Element.NodeType of
+  ELEMENT_NODE, TEXT_NODE, CDATA_SECTION_NODE,
+  PROCESSING_INSTRUCTION_NODE, COMMENT_NODE, DOCUMENT_TYPE_NODE:
+    if Assigned(Element.ParentNode)
+      then Result := GetBaseURI(Element.ParentNode, DocumentURI)
+      else Result := '';
+
+  ATTRIBUTE_NODE: begin
+    Result := '';
+    if Assigned(TDomAttr(Element).OwnerElement) then
+    begin
+      Result := GetBaseURI(TDomAttr(Element).OwnerElement, DocumentURI);
+    end;
+  end;
+
+  ENTITY_REFERENCE_NODE: begin
+    Ent := Element.OwnerDocument.DocType.Entities.GetNamedItem(Element.NodeName);
+    if Assigned(Ent) and (TDOMEntity(Ent).SystemID <> '') then
+    begin
+      Uri1 := TDOMEntity(Ent).SystemID;
+      if IsAbsoluteURI(Uri1) then
+      begin
+        Result := Uri1;
+      end else begin
+        Uri2 := GetBaseURI(Element.ParentNode, DocumentUri);
+        ResolveRelativeUri(Uri2, Uri1, s);
+        Result := s;
+      end;
+    end
+    else
+    begin
+      if Assigned(Element.ParentNode)
+        then Result := GetBaseURI(Element.ParentNode, DocumentURI)
+        else Result := '';
+    end;
+  end;
+
+  DOCUMENT_NODE: Result := DocumentURI;
+  else
+    Result := '';
+  end;
+end;
+
+{ TTestSuite }
+
+constructor TTestSuite.Create;
+begin
+  inherited Create;
+  FParser := TDOMParser.Create;
+  FParser.Options.PreserveWhitespace := True;
+end;
+
+procedure TTestSuite.ErrorHandler(Error: EXMLReadError);
+begin
+  if Error.Severity = esError then
+  begin
+    FValError := Error.Message;
+{ uncomment the line below to verify that the suite correctly handles
+  exception raised from the handler }    
+//  Abort;  
+  end;
+end;
+
+procedure TTestSuite.LoadTemplate(const Name: string);
+var
+  tables: TDOMNodeList;
+  I: Integer;
+  id: DOMString;
+  el: TDOMElement;
+begin
+  ReadXMLFile(FTemplate, Name);
+  tables := FTemplate.DocumentElement.GetElementsByTagName('table');
+  try
+    for I := 0 to tables.Count-1 do
+    begin
+      el := TDOMElement(tables.Item[I]);
+      id := el['id'];
+      if id = 'valid' then
+        table_valid := el
+      else if ((id = 'invalid-negative') and FValidating) or ((id = 'invalid-positive') and not FValidating) then
+        table_invalid := el
+      else if id = 'valid-output' then
+        table_output := el
+      else if id = 'not-wf' then
+        table_not_wf := el
+      else if id = 'error' then
+        table_informative := el;
+    end;
+  finally
+    tables.Free;
+  end;
+end;
+
+destructor TTestSuite.Destroy;
+begin
+  FDoc.Free;
+  FTemplate.Free;
+  FParser.Free;
+  inherited;
+end;
+
+procedure TTestSuite.HandleTemplatePIs(Element: TDOMNode);
+var
+  Children: TDOMNodeList;
+  Child: TDOMNode;
+  NewChild: TDOMNode;
+  Remove: Boolean;
+  Index: Integer;
+  Data: DOMString;
+begin
+  Children := element.childNodes;
+  Remove := False;
+  Index := 0;
+
+  repeat
+    Child := Children.Item[Index];
+    if Child = nil then Break;
+    Inc(index);
+
+    // inside a rejected <?if ...?>...<?endif?>
+    if Remove and (child.nodeType <> PROCESSING_INSTRUCTION_NODE) then
+    begin
+      Element.removeChild(child);
+      Dec(Index);
+      Continue;
+    end;
+    if Child.hasChildNodes then
+    begin
+      HandleTemplatePIs(Child);
+      Continue;
+    end;
+
+    if Child.nodeType <> PROCESSING_INSTRUCTION_NODE then
+      Continue;
+
+    Data := Child.NodeValue;
+
+    if Child.NodeName = 'run-id' then
+    begin
+      if Data = 'name' then
+        newChild := FTemplate.createTextNode(parser)
+      else if Data = 'description' then
+        newChild := FTemplate.createTextNode (parserName)
+      else if Data = 'general-entities' then
+        newChild := FTemplate.createTextNode('included')
+      else if Data = 'parameter-entities' then
+        newChild := FTemplate.createTextNode ('included')
+      else if Data = 'type' then
+      begin
+        if FValidating then
+           Data := 'Validating'
+        else
+           Data := 'Non-Validating';
+        newChild := FTemplate.createTextNode(Data);
+      end
+      // ... test run description
+      else if Data = 'date' then
+        newChild := FTemplate.createTextNode(DateTimeToStr(Now))
+      else if Data = 'harness' then
+        newChild := FTemplate.createTextNode(harness)
+      else if Data = 'java' then
+        newChild := FTemplate.createTextNode(runtime)
+      else if Data = 'os' then
+        newChild := FTemplate.createTextNode(os)
+      else if Data = 'testsuite' then
+        newChild := FTemplate.createTextNode(FSuiteTitle)
+      else if Data = 'version' then
+        newChild := FTemplate.createTextNode(version)
+      // ... test result info
+      else if Data = 'failed' then
+        newChild := FTemplate.createTextNode(IntToStr(FFailCount))
+      else if Data = 'passed' then
+        newChild := FTemplate.createTextNode(IntToStr(FPassed))
+      else if Data = 'passed-negative' then
+        newChild := FTemplate.createTextNode(IntToStr(FFalsePasses))
+      else if Data = 'skipped' then
+        newChild := FTemplate.createTextNode(IntToStr(FSkipped))
+      else if Data = 'status' then
+        newChild := FTemplate.createTextNode (FState);
+
+      Element.replaceChild (newChild, child);
+      Continue;
+    end
+
+    // if/endif don't nest, and always have the same parent
+    // we rely on those facts here!
+    else if Child.NodeName = 'if' then
+    begin
+      Remove := not (((Data = 'validating') and FValidating) or
+                   ((Data = 'nonvalidating') and not FValidating));
+      element.removeChild(child);
+      Dec(Index);
+      Continue;
+    end
+    else if Child.NodeName = 'endif' then
+    begin
+      Remove := False;
+      element.removeChild(child);
+      Dec(Index);
+      Continue;
+    end;
+  until False;
+  Children.Free;
+end;
+
+
+procedure TTestSuite.Run(const Tests: string);
+var
+  Cases: TDOMNodeList;
+  I: Integer;
+begin
+  FRootURI := FilenameToURI(Tests);
+  ReadXMLFile(FDoc, Tests);
+  FSuiteTitle := FDoc.DocumentElement['PROFILE'];
+  Cases := FDoc.DocumentElement.GetElementsByTagName('TEST');
+  writeln('Using test suite: ', Tests);
+  writeln;
+  writeln('Testing, validation = ', FValidating);
+  try
+    for I := 0 to Cases.Count-1 do
+      RunTest(Cases.Item[I] as TDOMElement);
+    I := Cases.Count;
+  finally
+    Cases.Free;
+  end;
+
+  FPassed := FTotal-FFailCount;
+  Dec(FPassed, FSkipped);
+
+  writeln('Found ', I, ' basic test cases.');
+  writeln('Found ', FTotal, ' overall test cases.');
+  writeln('Skipped: ', FSkipped);
+  writeln('Passed: ', FPassed);
+  writeln('Failed: ', FFailCount);
+  writeln('Negative passes: ', FFalsePasses, ' (need examination).');
+  writeln;
+
+  if FPassed = 0 then
+    FState := 'N/A'
+  else if FPassed = FTotal then
+    FState := 'CONFORMS (provisionally)'
+  else
+    FState := 'DOES NOT CONFORM';
+
+end;
+
+procedure TTestSuite.RunTest(Element: TDOMElement);
+var
+  s: UTF8string;
+  TestType: DOMString;
+  TempDoc, RefDoc: TXMLDocument;
+  table: TDOMNode;
+  Positive: Boolean;
+  outURI: UTF8string;
+  FailMsg: string;
+  docNode, refNode: TDOMNode;
+  docMap, refMap: TDOMNamedNodeMap;
+  docN, refN: TDOMNotation;
+  I: Integer;
+  root: UTF8String;
+begin
+  FTestID := Element['ID'];
+  TestType := Element['TYPE'];
+  root := GetBaseURI(Element, FRootUri);
+  ResolveRelativeURI(root, UTF8Encode(Element['URI']), s);
+
+  table := nil;
+  outURI := '';
+  if TestType = 'not-wf' then
+  begin
+    table := table_not_wf;
+    Positive := False;
+  end
+  else if TestType = 'error' then
+  begin
+    table := table_informative;
+    Positive := False;
+  end
+  else if TestType = 'valid' then
+  begin
+    if Element.hasAttribute('OUTPUT') then
+      ResolveRelativeURI(root, UTF8Encode(Element['OUTPUT']), outURI);
+    table := table_valid;
+    Positive := True;
+  end
+  else if TestType = 'invalid' then
+  begin
+    table := table_invalid;
+    Positive := not FValidating;
+  end;
+
+  if TestType <> 'error' then
+  begin
+    Inc(FTotal);
+    if outURI <> '' then Inc(FTotal);
+  end;
+
+  FailMsg := '';
+  FValError := '';
+  TempDoc := nil;
+  try
+    try
+      FParser.Options.Validate := FValidating;
+      FParser.OnError := {$IFDEF FPC}@{$ENDIF}ErrorHandler;
+      FParser.ParseUri(s, TempDoc);
+    except
+      on E: Exception do
+        if E.ClassType <> EAbort then
+          FailMsg := E.Message;
+    end;
+    if FailMsg <> '' then  // fatal errors take precedence
+      FValError := '';
+
+    if not Positive then  // must have been failed
+    begin
+      if TestType = 'error' then
+      begin
+        if FailMsg <> '' then
+          Diagnose(element, table, dcInfo, FailMsg)
+        else
+          Diagnose(element, table, dcInfo, FValError);
+      end
+      else if (FailMsg = '') and (FValError = '') then
+      begin
+        Inc(FFailCount);
+        Diagnose(element, table, dcNegfail, '');
+      end
+      else // FailMsg <> '' or FValError <> '' -> actually failed
+      begin
+        Inc(FFalsePasses);
+        if FailMsg <> '' then
+          Diagnose(Element, table, dcPass, FailMsg)
+        else
+          Diagnose(Element, table, dcPass, FValError);
+      end;
+      Exit;
+    end
+    else   // must have been succeeded
+      if (FailMsg <> '') or (FValError <> '') then
+      begin
+        Inc(FFailCount);
+        if FailMsg <> '' then
+          Diagnose(Element, table, dcFail, FailMsg)
+        else
+          Diagnose(Element, table, dcFail, FValError);
+        if (outURI <> '') and (FailMsg <> '') then
+        begin
+          Inc(FFailCount);
+          DiagnoseOut('[ input failed, no output to test ]');
+        end;
+        Exit;
+      end;
+
+    if outURI = '' then Exit;
+    Canonicalize(TempDoc);
+    TempDoc.DocumentElement.Normalize;
+    try
+      // reference data must be parsed in non-validating mode because it contains DTDs
+      // only when Notations need to be reported
+      FParser.Options.Validate := False;
+      FParser.ParseUri(outURI, RefDoc);
+      try
+        docNode := TempDoc.FirstChild;
+        refNode := RefDoc.FirstChild;
+        repeat
+          if refNode = nil then
+          begin
+            if docNode <> nil then
+            begin
+              Inc(FFailCount);
+              DiagnoseOut('Extra data: ' + docNode.NodeName + ' / ' + docNode.NodeValue);
+            end;
+            Exit;
+          end;
+          if docNode = nil then
+          begin
+            Inc(FFailCount);
+            DiagnoseOut('Missing data: ' + refNode.NodeName + ' / ' + refNode.NodeValue);
+            Exit;
+          end;
+
+          if refNode.NodeType = DOCUMENT_TYPE_NODE then
+          begin
+            if docNode.NodeType <> DOCUMENT_TYPE_NODE then
+            begin
+              Inc(FFailCount);
+              DiagnoseOut('[ no doctype from parsing testcase ]');
+              Exit;
+            end;
+
+            refMap := TDOMDocumentType(refNode).Notations;
+            docMap := TDOMDocumentType(docNode).Notations;
+
+            for I := 0 to refMap.Length-1 do
+            begin
+              refN := TDOMNotation(refMap[I]);
+              docN := TDOMNotation(docMap.GetNamedItem(refMap[I].NodeName));
+              if not Assigned(docN) then
+              begin
+                Inc(FFailCount);
+                DiagnoseOut('missing notation declaration: ' + refN.NodeName);
+                Exit;
+              end;
+              if (refN.PublicID <> docN.PublicID) or (refN.SystemID <> docN.SystemID) then
+              begin
+                Inc(FFailCount);
+                DiagnoseOut('incorrect notation declaration: ' + refN.NodeName);
+                Exit;
+              end;
+            end;
+
+            refNode := refNode.NextSibling;
+            docNode := docNode.NextSibling;
+            Continue;
+          end;
+
+          if docNode.NodeType = DOCUMENT_TYPE_NODE then  // skip DocType
+            docNode := docNode.NextSibling;
+
+          if not CompareNodes(docNode, refNode, FailMsg) then
+          begin
+            Inc(FFailCount);
+            DiagnoseOut(FailMsg);
+            Exit;
+          end;
+
+          docNode := docNode.NextSibling;
+          refNode := refNode.NextSibling;
+        until False;
+      finally
+        RefDoc.Free;
+      end;
+    except
+      on E: Exception do
+      begin
+        Inc(FFailCount);
+        DiagnoseOut('[ can''t read reference data: '+E.Message+' ]');
+      end;
+    end;
+  finally
+    TempDoc.Free;
+  end;
+end;
+
+
+procedure TTestSuite.Diagnose(Element, Table: TDOMNode; Category: TDiagCategory;
+  const Error: DOMString);
+var
+  tr, td, txt, tmp: TDOMNode;
+  s: DOMString;
+begin
+  tr := FTemplate.CreateElement('tr');
+  if Assigned(Element) then              // column 1: section/chapter, if known
+  begin
+    s := TDOMElement(Element)['SECTIONS'];
+    td := FTemplate.CreateElement('td');
+    td.AppendChild(FTemplate.CreateTextNode(s));
+    tr.AppendChild(td);
+  end;
+
+  td := FTemplate.CreateElement('td');   // column 2: test ID
+  td.AppendChild(FTemplate.CreateTextNode(FTestID));
+  tr.AppendChild(td);
+  // third column is description
+  if Assigned(Element) then
+  begin
+    td := FTemplate.CreateElement('td');
+    txt := Element.FirstChild;
+    while Assigned(txt) do
+    begin
+      td.AppendChild(txt.CloneNode(true, FTemplate));
+      txt := txt.NextSibling;
+    end;
+    tr.AppendChild(td);
+  end;
+  // fourth column is reason
+  td := FTemplate.CreateElement('td');
+  if Element = nil then
+    s := Error
+  else if Category <> dcInfo then
+  begin
+    if Error <> '' then
+    begin
+      if FValError <> '' then
+        s := '(error) ' + Error
+      else
+        s := '(fatal) ' + Error;
+    end
+    else
+      s := '[wrongly accepted]';
+  end
+  else // informative
+  begin
+    if Error <> '' then
+      s := Error
+    else
+      s := '[accepted]';
+  end;
+  // TODO: use &nbsp if text is empty
+  txt := FTemplate.CreateTextNode(s);
+
+  if (Category <> dcPass) and (Category <> dcInfo) then
+  begin
+    tmp := FTemplate.CreateElement('em');
+    tmp.AppendChild(txt);
+    txt := tmp;
+    TDOMElement(td)['bgcolor'] := '#ffaacc';
+  end;
+  td.AppendChild(txt);
+  tr.AppendChild(td);
+
+  table.AppendChild(tr);
+end;
+
+procedure TTestSuite.DiagnoseOut(const ErrorMsg: DOMString);
+var
+  tr, td, txt: TDOMNode;
+begin
+  tr := FTemplate.CreateElement('tr');
+
+  td := FTemplate.CreateElement('td');
+  td.AppendChild(FTemplate.CreateTextNode(FTestID));
+  tr.AppendChild(td);
+
+  td := FTemplate.CreateElement('td');
+  txt := FTemplate.CreateElement('em');
+  txt.AppendChild(FTemplate.CreateTextNode(ErrorMsg));
+  td.AppendChild(txt);
+  TDOMElement(td)['bgcolor'] := '#ffaacc';
+  tr.AppendChild(td);
+  table_output.AppendChild(tr);
+end;
+
+
+procedure TTestSuite.Canonicalize(node: TDOMNode);
+var
+  child, work: TDOMNode;
+  Frag: TDOMDocumentFragment;
+begin
+  child := node.FirstChild;
+  while Assigned(child) do
+  begin
+    if child.NodeType = CDATA_SECTION_NODE then
+    begin
+      work := node.OwnerDocument.CreateTextNode(child.NodeValue);
+      node.ReplaceChild(work, child);
+      child := work;
+    end
+    else if child.NodeType = COMMENT_NODE then
+    begin
+      work := child.NextSibling;
+      node.RemoveChild(child);
+      child := work;
+      Continue;
+    end
+    else if child.NodeType = ENTITY_REFERENCE_NODE then
+    begin
+      Frag := node.OwnerDocument.CreateDocumentFragment;
+      try
+        work := child.FirstChild;
+        while Assigned(work) do
+        begin
+          Frag.AppendChild(work.CloneNode(true));
+          work := work.NextSibling;
+        end;
+        work := Frag.FirstChild;     // references may be nested
+        if work = nil then
+          work := Child.PreviousSibling;
+
+        node.ReplaceChild(Frag, child);
+        child := work;
+      finally
+        Frag.Free;
+      end;
+      Continue;
+    end;
+    if child.HasChildNodes then
+      Canonicalize(child);
+    child := child.NextSibling;
+  end;
+end;
+
+function TTestSuite.CompareNodes(actual, correct: TDOMNode;
+  out Msg: string): Boolean;
+var
+  actAtts, refAtts: TDOMNamedNodeMap;
+  actList, refList: TDOMNodeList;
+  I: Integer;
+  s1, s2: DOMString;
+begin
+  Msg := '';
+  Result := False;
+  if actual.NodeType <> correct.NodeType then
+    FmtStr(Msg, 'actual.NodeType (%d) != correct.NodeType (%d)', [actual.NodeType, correct.NodeType])
+  else if actual.NodeName <> correct.NodeName then
+    FmtStr(Msg, 'actual.NodeName (%s) != correct.NodeName (%s)', [actual.NodeName, correct.NodeName])
+  else if actual.NodeValue <> correct.NodeValue then
+    FmtStr(Msg, 'actual.NodeValue (%s) != correct.NodeValue (%s)', [actual.NodeValue, correct.NodeValue]);
+  if Msg <> '' then
+    Exit;
+
+  if actual.NodeType = ELEMENT_NODE then
+  begin
+    // first, compare attributes
+    actAtts := actual.Attributes;
+    refAtts := correct.Attributes;
+    if actAtts.Length <> refAtts.Length then
+    begin
+      FmtStr(Msg, 'Element ''%s'': attributes.length (%d) != %d', [actual.NodeName, actAtts.Length, refAtts.Length]);
+      Exit;
+    end;
+    for I := 0 to actAtts.Length -1 do
+    begin
+      s1 := refAtts.GetNamedItem(actAtts[I].NodeName).NodeValue;
+      s2 := actAtts[I].NodeValue;
+      if s1 <> s2 then
+      begin
+        FmtStr(Msg, 'Element ''%s'', attribute ''%s'': actual.AttValue (%s) != correct.AttValue (%s)', [actual.NodeName, actAtts[I].NodeName, s2, s1]);
+        Exit;
+      end;
+    end;
+    // next, compare children
+    actList := actual.ChildNodes;
+    refList := correct.ChildNodes;
+    try
+      if actList.Count <> refList.Count then
+      begin
+        FmtStr(Msg, 'Element ''%s'': actual.ChildNodeCount (%d) != correct.ChildNodeCount (%d)', [actual.NodeName, actList.Count, refList.Count]);
+        Exit;
+      end;
+      for I := 0 to actList.Count -1 do
+        if not CompareNodes(actList[I], refList[I], Msg) then
+          Exit;
+    finally
+      actList.Free;
+      refList.Free;
+    end;
+  end;
+  Result := True;
+end;
+
+
+
+var
+  i: Integer;
+  s: string;
+  SuiteName, ReportName, TemplateName: string;
+  Validation: Boolean;
+begin
+  writeln('FCL driver for OASIS/NIST XML Test Suite');
+  writeln('Copyright (c) 2006 by Sergei Gorelkin');
+  TemplateName := ExtractFilePath(ParamStr(0)) + 'template.xml';
+  if ParamCount < 2 then
+  begin
+    writeln;
+    writeln('Usage: ', ParamStr(0), ' <suite> <report> [-t template][-v]');
+    writeln('  -t: specify report template');
+    writeln('  -v: validating mode');
+    Exit;
+  end;
+
+  SuiteName := ExpandFilename(ParamStr(1));
+  ReportName := ExpandFilename(ParamStr(2));
+  i := 3;
+  Validation := False;
+  while i <= ParamCount do
+  begin
+    s := Lowercase(ParamStr(i));
+    if s = '-v' then
+      Validation := True
+    else if s = '-t' then
+      TemplateName := ExpandFileName(ParamStr(i+1));
+    Inc(i);
+  end;
+
+  with TTestSuite.Create do
+  try
+    FSuiteName := SuiteName;
+    FTemplateName := TemplateName;
+    FValidating := Validation;
+    LoadTemplate(FTemplateName);
+    if Assigned(FTemplate) then
+    begin
+      Run(FSuiteName);
+      HandleTemplatePIs(FTemplate.DocumentElement);
+      writeln('Writing report to: ', ReportName);
+      WriteXMLFile(FTemplate, ReportName);
+    end;
+  finally
+    Free;
+  end;
+
+end.