--- Merging r13787 into '.':

U    packages/fcl-xml/tests/domunit.pp
--- Merging r13788 into '.':
U    packages/fcl-xml/tests/extras.pp
--- Merging r13789 into '.':
U    packages/fcl-xml/src/xmlwrite.pp
U    packages/fcl-xml/src/dom.pp
U    packages/fcl-xml/src/xmlutils.pp
--- Merging r13800 into '.':
U    packages/fcl-xml/tests/api.xml
G    packages/fcl-xml/src/dom.pp
--- Merging r13809 into '.':
G    packages/fcl-xml/src/dom.pp
U    packages/fcl-xml/src/xmlread.pp
--- Merging r13816 into '.':
U    packages/fcl-xml/src/xpath.pp
--- Merging r13817 into '.':
G    packages/fcl-xml/src/dom.pp
G    packages/fcl-xml/src/xmlutils.pp
--- Merging r13818 into '.':
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13824 into '.':
G    packages/fcl-xml/src/dom.pp
--- Merging r13827 into '.':
G    packages/fcl-xml/src/xpath.pp
--- Merging r13842 into '.':
G    packages/fcl-xml/src/xpath.pp
--- Merging r13846 into '.':
U    packages/fcl-xml/tests/xpathts.pp
G    packages/fcl-xml/src/xpath.pp
--- Merging r13856 into '.':
G    packages/fcl-xml/src/xmlwrite.pp
--- Merging r13858 into '.':
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13860 into '.':
U    packages/fcl-xml/tests/xmlts.pp
--- Merging r13861 into '.':
G    packages/fcl-xml/src/xmlutils.pp
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13878 into '.':
G    packages/fcl-xml/tests/extras.pp
U    packages/fcl-xml/tests/extras2.pp
--- Merging r13886 into '.':
G    packages/fcl-xml/src/xmlutils.pp
--- Merging r13894 into '.':
G    packages/fcl-xml/src/xmlwrite.pp
--- Merging r13906 into '.':
G    packages/fcl-xml/src/xmlwrite.pp
--- Merging r13914 into '.':
G    packages/fcl-xml/tests/extras2.pp
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13915 into '.':
G    packages/fcl-xml/src/xpath.pp
--- Merging r13921 into '.':
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13922 into '.':
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13960 into '.':
G    packages/fcl-xml/src/xmlread.pp
--- Merging r13961 into '.':
G    packages/fcl-xml/src/xmlread.pp

Merged XML revisions before 14000

------------------------------------------------------------------------
r13787 | sergei | 2009-10-01 21:11:47 +0200 (Thu, 01 Oct 2009) | 2 lines

* r13729 was broken due to missing typecast, shame on me. Fixed.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13788 | sergei | 2009-10-01 21:14:36 +0200 (Thu, 01 Oct 2009) | 1 line

+ 3 more tests for verifying the namespace fixup
------------------------------------------------------------------------
------------------------------------------------------------------------
r13789 | sergei | 2009-10-01 21:29:13 +0200 (Thu, 01 Oct 2009) | 1 line

+ XML writer now performs the namespace normalization.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13800 | sergei | 2009-10-04 01:35:20 +0200 (Sun, 04 Oct 2009) | 4 lines

Two more DOM Level 3 functions + tests for them:
+ TDOMNode.lookupPrefix()
+ TDOMNode.isDefaultNamespaceURI()

------------------------------------------------------------------------
------------------------------------------------------------------------
r13809 | sergei | 2009-10-06 13:03:25 +0200 (Tue, 06 Oct 2009) | 2 lines

* TDOMDocument now checks its children and allows only a single Element/DocType child. This fixes about 8 test cases at Level 3.
+ Initial moves to implement TDOMNode.BaseURI (not yet functional)
------------------------------------------------------------------------
------------------------------------------------------------------------
r13816 | sergei | 2009-10-07 23:27:11 +0200 (Wed, 07 Oct 2009) | 1 line

* For some reason, any assignment of NaN cannot be compiled with overflow checking, issue #14748.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13817 | sergei | 2009-10-08 02:46:27 +0200 (Thu, 08 Oct 2009) | 1 line

* Fixed (runtime) overflows and range checks, so the package runs after compiling with OPT="-Criot -gtl". That Delphi compatibility patch is starting to cause more trouble than benefit...
------------------------------------------------------------------------
------------------------------------------------------------------------
r13818 | sergei | 2009-10-08 16:48:34 +0200 (Thu, 08 Oct 2009) | 4 lines

xmlread.pp:
* Report unclosed Ignore section as soon as it is detected, improves error messages and simplifies the code.
* Since SkipUntilSeq is only ever called with 1 or 2 delimiter chars, support just that rather than arbitrary-length array. Simplifies code.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13824 | sergei | 2009-10-09 17:37:15 +0200 (Fri, 09 Oct 2009) | 1 line

* Hunted down another node pool bug, thanks to Vincent Snijders and mighty valgrind. Due to wrong condition, the last block of extent wasn't used to put an object there, but later a cleanup attempt at that address was attempted.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13827 | sergei | 2009-10-09 19:47:53 +0200 (Fri, 09 Oct 2009) | 2 lines

xpath.pp: Fixed runtime range and overflow checks, at least those which could be detected with existing test suite.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13842 | sergei | 2009-10-11 01:57:39 +0200 (Sun, 11 Oct 2009) | 1 line

xpath.pp: cleaned up and simplified TXPathScanner.GetToken()
------------------------------------------------------------------------
------------------------------------------------------------------------
r13846 | sergei | 2009-10-11 17:04:33 +0200 (Sun, 11 Oct 2009) | 7 lines

xpath.pp:
* Progress with namespace support. Resolve namespace prefixed while parsing, compare namespaceURI/localNames while evaluating. Existing tests for namespace-uri(), local-name() and name() now all pass, but resolving interface isn't ready for general use yet.
* Fixed name() to default to context node if argument is omitted.

xpathts.pp:
+ support for prefix resolving while testing.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13856 | sergei | 2009-10-13 23:50:07 +0200 (Tue, 13 Oct 2009) | 1 line

xmlwrite.pp: c14n compliance: write whitespace after PI name only if its data is not empty
------------------------------------------------------------------------
------------------------------------------------------------------------
r13858 | sergei | 2009-10-15 00:12:27 +0200 (Thu, 15 Oct 2009) | 4 lines

xmlread.pp, refactoring of literal handling:
* separate procedure SkipQuote, reused by SkipQuotedLiteral and ExpectAttValue;
* inlined SkipPubidLiteral to the (only) place where it is called.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13860 | sergei | 2009-10-15 23:27:31 +0200 (Thu, 15 Oct 2009) | 1 line

* Only EXMLReadError is expected to be thrown from a negative test, any other exception is unexpected and should render the test as failed.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13861 | sergei | 2009-10-16 00:11:13 +0200 (Fri, 16 Oct 2009) | 1 line

xmlread.pp: now uses TNSSupport class from xmlutils unit instead of its own copy of the same code.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13878 | sergei | 2009-10-17 00:50:46 +0200 (Sat, 17 Oct 2009) | 1 line

Fixed memory leaks in tests.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13886 | sergei | 2009-10-17 13:02:01 +0200 (Sat, 17 Oct 2009) | 3 lines

* TNSSupport.CheckAttribute added check for null nsURI, it should not emit prefixes for namespaceless attributes.
* Reformatted and fixed comments.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13894 | sergei | 2009-10-17 14:30:04 +0200 (Sat, 17 Oct 2009) | 1 line

XML writer: write namespace declarations before attribites and optionally sort them as required by c14n.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13906 | sergei | 2009-10-18 00:09:20 +0200 (Sun, 18 Oct 2009) | 3 lines

* Changed TSpecialCharCallback from method into a regular procedure, this allows to drop all the {$ifdef fpc}@{$endif} ugliness.
* Also changed TSpecialCharCallback to take the string and the index, so it can process certain sequences, not only single chars.
* In canonical mode, CDATA sections are written as text.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13914 | sergei | 2009-10-21 00:09:51 +0200 (Wed, 21 Oct 2009) | 2 lines

+ Initial implementation of property TDOMParseOptions.CanonicalForm. The only thing it does yet is ignoring the DTD.
* Fixed relevant tests.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13915 | sergei | 2009-10-21 00:13:13 +0200 (Wed, 21 Oct 2009) | 4 lines

xpath.pp:
* text() selector matches text and CDATA nodes, but not comments
* Names of processing instructions are now matched as they should.

------------------------------------------------------------------------
------------------------------------------------------------------------
r13921 | sergei | 2009-10-23 01:41:24 +0200 (Fri, 23 Oct 2009) | 4 lines

Straightening handling of base URI and SystemID:
- TXMLCharSource.PublicID removed, it is unused.
* Base URI of an entity is stored in FURI field of entity, and passed to ResolveEntity.
* When error happens while parsing an internal entity, report the URI where that entity was declared, not where it was included.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13922 | sergei | 2009-10-23 06:16:15 +0200 (Fri, 23 Oct 2009) | 2 lines

* Fixed the order of checks during parsing the xml declaration, this provides more accurate diagnostic for tests dtd07, encoding07, ibm77n03.
* Delay switching to xml 1.1 rules until the declaration has been parsed, this ensures that NEL and LSEP chars in declaration are rejected (rmt-056, rmt-057).
------------------------------------------------------------------------
------------------------------------------------------------------------
r13960 | sergei | 2009-10-26 20:17:54 +0100 (Mon, 26 Oct 2009) | 1 line

* Fixed bug in length calculation, causing any namespaced attributes with local part differing only in the last character (or consisting of a single character), to be erroneously reported as duplicate.
------------------------------------------------------------------------
------------------------------------------------------------------------
r13961 | sergei | 2009-10-26 22:23:24 +0100 (Mon, 26 Oct 2009) | 4 lines

xmlread.pp, tighten up checks while parsing the xml declaration:
* Hard limit of literal lengths: 3 on version, 30 on encoding name, 2 or 3 on standalone. Without this, a misplaced quote could cause excessive amount of processing, because input buffer is reloaded by small 3-char chunks at this time.
* Encoding validity is checked in-line, the very first illegal character aborts processing.

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14634 -

packages/fcl-xml/src/dom.pp

@@ -101,7 +101,7 @@ type
   TDOMAttrDef = class;
   TNodePool = class;
   PNodePoolArray = ^TNodePoolArray;
-  TNodePoolArray = array[0..0] of TNodePool;
+  TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
 
 {$ifndef fpc}
   TFPList = TList;
@@ -216,6 +216,7 @@ type
     function GetPrefix: DOMString; virtual;
     procedure SetPrefix(const Value: DOMString); virtual;
     function GetOwnerDocument: TDOMDocument; virtual;
+    function GetBaseURI: DOMString;
     procedure SetReadOnly(Value: Boolean);
     procedure Changing;
   public
@@ -255,11 +256,15 @@ type
     property Prefix: DOMString read GetPrefix write SetPrefix;
     // DOM level 3
     property TextContent: DOMString read GetTextContent write SetTextContent;
+    function LookupPrefix(const nsURI: DOMString): DOMString;
     function LookupNamespaceURI(const APrefix: DOMString): DOMString;
+    function IsDefaultNamespace(const nsURI: DOMString): Boolean;
+    property baseURI: DOMString read GetBaseURI;
     // Extensions to DOM interface:
     function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
     function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
     function CompareName(const name: DOMString): Integer; virtual;
+    property Flags: TNodeFlags read FFlags;
   end;
 
   TDOMNodeClass = class of TDOMNode;
@@ -450,6 +455,8 @@ type
     function Alloc(AClass: TDOMNodeClass): TDOMNode;
   public
     function IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean = False): Integer;
+    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
+    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
     property DocType: TDOMDocumentType read GetDocType;
     property Impl: TDOMImplementation read FImplementation;
     property DocumentElement: TDOMElement read GetDocumentElement;
@@ -575,6 +582,7 @@ type
     function GetNodeType: Integer; override;
     function GetAttributes: TDOMNamedNodeMap; override;
     procedure AttachDefaultAttrs;
+    function InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
     procedure RestoreDefaultAttr(AttrDef: TDOMAttr);
   public
     destructor Destroy; override;
@@ -1140,10 +1148,17 @@ function GetAncestorElement(n: TDOMNode): TDOMElement;
 var
   parent: TDOMNode;
 begin
-  parent := n.ParentNode;
-  while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
-    parent := parent.ParentNode;
-  Result := TDOMElement(parent);
+  case n.nodeType of
+    DOCUMENT_NODE:
+      result := TDOMDocument(n).documentElement;
+    ATTRIBUTE_NODE:
+      result := TDOMAttr(n).OwnerElement;
+  else
+    parent := n.ParentNode;
+    while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
+      parent := parent.ParentNode;
+    Result := TDOMElement(parent);
+  end;  
 end;
 
 // TODO: specs prescribe to return default namespace if APrefix=null,
@@ -1158,39 +1173,89 @@ begin
   Result := '';
   if Self = nil then
     Exit;
-  case NodeType of
-    ELEMENT_NODE:
+  if nodeType = ELEMENT_NODE then
+  begin
+    if (nfLevel2 in FFlags) and (TDOMElement(Self).Prefix = APrefix) then
+    begin
+      result := Self.NamespaceURI;
+      Exit;
+    end;
+    if HasAttributes then
     begin
-      if (nfLevel2 in FFlags) and (TDOMElement(Self).Prefix = APrefix) then
+      Map := Attributes;
+      for I := 0 to Map.Length-1 do
       begin
-        result := Self.NamespaceURI;
-        Exit;
-      end;
-      if HasAttributes then
+        Attr := TDOMAttr(Map[I]);
+        // should ignore level 1 atts here
+        if ((Attr.Prefix = 'xmlns') and (Attr.localName = APrefix)) or
+           ((Attr.localName = 'xmlns') and (APrefix = '')) then
+        begin
+          result := Attr.NodeValue;
+          Exit;
+        end;
+      end
+    end;
+  end;  
+  result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
+end;
+
+function TDOMNode.LookupPrefix(const nsURI: DOMString): DOMString;
+begin
+  Result := '';
+  if (nsURI = '') or (Self = nil) then
+    Exit;
+  if nodeType = ELEMENT_NODE then
+    result := TDOMElement(Self).InternalLookupPrefix(nsURI, TDOMElement(Self))
+  else
+    result := GetAncestorElement(Self).LookupPrefix(nsURI);
+end;
+
+function TDOMNode.IsDefaultNamespace(const nsURI: DOMString): Boolean;
+var
+  Attr: TDOMAttr;
+  Map: TDOMNamedNodeMap;
+  I: Integer;
+begin
+  Result := False;
+  if Self = nil then
+    Exit;
+  if nodeType = ELEMENT_NODE then
+  begin
+    if TDOMElement(Self).FNSI.PrefixLen = 0 then
+    begin
+      result := (nsURI = namespaceURI);
+      Exit;
+    end  
+    else if HasAttributes then
+    begin
+      Map := Attributes;
+      for I := 0 to Map.Length-1 do
       begin
-        Map := Attributes;
-        for I := 0 to Map.Length-1 do
+        Attr := TDOMAttr(Map[I]);
+        if Attr.LocalName = 'xmlns' then
         begin
-          Attr := TDOMAttr(Map[I]);
-          // should ignore level 1 atts here
-          if ((Attr.Prefix = 'xmlns') and (Attr.localName = APrefix)) or
-             ((Attr.localName = 'xmlns') and (APrefix = '')) then
-          begin
-            result := Attr.NodeValue;
-            Exit;
-          end;
-        end
+          result := (Attr.Value = nsURI);
+          Exit;
+        end;
       end;
-      result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
     end;
-    DOCUMENT_NODE:
-      result := TDOMDocument(Self).documentElement.LookupNamespaceURI(APrefix);
-
-    ATTRIBUTE_NODE:
-      result := TDOMAttr(Self).OwnerElement.LookupNamespaceURI(APrefix);
+  end;
+  result := GetAncestorElement(Self).IsDefaultNamespace(nsURI);
+end;
 
+function TDOMNode.GetBaseURI: DOMString;
+begin
+  case NodeType of
+  // !! Incomplete !!
+    DOCUMENT_NODE:
+      result := TDOMDocument(Self).FDocumentURI;
+    PROCESSING_INSTRUCTION_NODE:
+      if Assigned(ParentNode) then
+        result := ParentNode.GetBaseURI
+      else
+        result := OwnerDocument.DocumentURI;
   else
-    Result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
+    result := '';
   end;
 end;
 
@@ -2167,6 +2232,32 @@ begin
   Result := nil;
 end;
 
+function TDOMDocument.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
+var
+  nType: Integer;
+begin
+  nType := NewChild.NodeType;
+  if ((nType = ELEMENT_NODE) and Assigned(DocumentElement)) or
+     ((nType = DOCUMENT_TYPE_NODE) and Assigned(DocType)) then
+       raise EDOMHierarchyRequest.Create('Document.InsertBefore');
+  Result := inherited InsertBefore(NewChild, RefChild);
+end;
+
+function TDOMDocument.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
+var
+  nType: Integer;
+begin
+  nType := NewChild.NodeType;
+  if ((nType = ELEMENT_NODE) and (OldChild = DocumentElement)) or   // root can be replaced by another element
+     ((nType = DOCUMENT_TYPE_NODE) and (OldChild = DocType)) then   // and so can be DTD
+  begin
+    inherited InsertBefore(NewChild, OldChild);
+    Result := RemoveChild(OldChild);
+  end
+  else
+    Result := inherited ReplaceChild(NewChild, OldChild);
+end;
+
 function TDOMDocument.GetDocumentElement: TDOMElement;
 var
   node: TDOMNode;
@@ -2677,6 +2768,36 @@ begin
   end;
 end;
 
+function TDOMElement.InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
+var
+  I: Integer;
+  Attr: TDOMAttr;
+begin
+  result := '';
+  if Self = nil then
+    Exit;
+  if (nfLevel2 in FFlags) and (namespaceURI = nsURI) and (FNSI.PrefixLen > 0) then
+  begin
+    Result := Prefix;
+    if Original.LookupNamespaceURI(result) = nsURI then
+      Exit;
+  end;
+  if Assigned(FAttributes) then
+  begin
+    for I := 0 to FAttributes.Length-1 do
+    begin
+      Attr := TDOMAttr(FAttributes[I]);
+      if (Attr.Prefix = 'xmlns') and (Attr.Value = nsURI) then
+      begin
+        result := Attr.LocalName;
+        if Original.LookupNamespaceURI(result) = nsURI then
+          Exit;
+      end;
+    end;
+  end;
+  result := GetAncestorElement(Self).InternalLookupPrefix(nsURI, Original);
+end;
+
 procedure TDOMElement.RestoreDefaultAttr(AttrDef: TDOMAttr);
 var
   Attr: TDOMAttr;
@@ -3218,7 +3339,7 @@ begin
   end
   else
   begin
-    if PAnsiChar(FCurrBlock) = PAnsiChar(FCurrExtent) + sizeof(TExtent) then
+    if PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent) then
       AddExtent(FCurrExtentSize * 2);
     Result := FCurrBlock;
     Dec(PAnsiChar(FCurrBlock), FElementSize);

packages/fcl-xml/src/xmlread.pp

@@ -67,7 +67,10 @@ type
     FResolveExternals: Boolean;
     FNamespaces: Boolean;
     FDisallowDoctype: Boolean;
+    FCanonical: Boolean;
     FMaxChars: Cardinal;
+    function GetCanonical: Boolean;
+    procedure SetCanonical(aValue: Boolean);
   public
     property Validate: Boolean read FValidate write FValidate;
     property PreserveWhitespace: Boolean read FPreserveWhitespace write FPreserveWhitespace;
@@ -78,6 +81,7 @@ type
     property Namespaces: Boolean read FNamespaces write FNamespaces;
     property DisallowDoctype: Boolean read FDisallowDoctype write FDisallowDoctype;
     property MaxChars: Cardinal read FMaxChars write FMaxChars;
+    property CanonicalForm: Boolean read GetCanonical write SetCanonical;
   end;
 
   // NOTE: DOM 3 LS ACTION_TYPE enumeration starts at 1
@@ -94,7 +98,7 @@ type
   private
     FStream: TStream;
     FStringData: string;
-//    FBaseURI: WideString;
+    FBaseURI: WideString;
     FSystemID: WideString;
     FPublicID: WideString;
 //    FEncoding: string;
@@ -103,7 +107,7 @@ type
     constructor Create(const AStringData: string); overload;
     property Stream: TStream read FStream;
     property StringData: string read FStringData;
-//    property BaseURI: WideString read FBaseURI write FBaseURI;
+    property BaseURI: WideString read FBaseURI write FBaseURI;
     property SystemID: WideString read FSystemID write FSystemID;
     property PublicID: WideString read FPublicID write FPublicID;
 //    property Encoding: string read FEncoding write FEncoding;
@@ -191,10 +195,8 @@ type
     LFPos: PWideChar;
     FXML11Rules: Boolean;
     FSystemID: WideString;
-    FPublicID: WideString;
     FCharCount: Cardinal;
     function GetSystemID: WideString;
-    function GetPublicID: WideString;
   protected
     function Reload: Boolean; virtual;
   public
@@ -208,7 +210,6 @@ type
     function SetEncoding(const AEncoding: string): Boolean; virtual;
     function Matches(const arg: WideString): Boolean;
     property SystemID: WideString read GetSystemID write FSystemID;
-    property PublicID: WideString read GetPublicID write FPublicID;
   end;
 
   TXMLDecodingSource = class(TXMLCharSource)
@@ -307,14 +308,6 @@ type
 
   TCheckNameFlags = set of (cnOptional, cnToken);
   
-  TBinding = class
-  public
-    uri: WideString;
-    next: TBinding;
-    prevPrefixBinding: TObject;
-    Prefix: PHashItem;
-  end;
-
   TPrefixedAttr = record
     Attr: TDOMAttr;
     PrefixLen: Integer;  // to avoid recalculation
@@ -345,12 +338,10 @@ type
     FDTDStartPos: PWideChar;
     FIntSubset: TWideCharBuf;
     FAttrTag: Cardinal;
-    FPrefixes: THashTable;
-    FBindings: TFPList;
-    FDefaultPrefix: THashItem;
+    FOwnsDoctype: Boolean;
+
+    FNSHelper: TNSSupport;
     FWorkAtts: array of TPrefixedAttr;
-    FBindingStack: array of TBinding;
-    FFreeBindings: TBinding;
     FNsAttHash: TDblHashArray;
     FStdPrefix_xml: PHashItem;
     FStdPrefix_xmlns: PHashItem;
@@ -364,9 +355,10 @@ type
     FResolveExternals: Boolean;
     FNamespaces: Boolean;
     FDisallowDoctype: Boolean;
+    FCanonical: Boolean;
     FMaxChars: Cardinal;
 
-    procedure RaiseExpectedQmark;
+    procedure SkipQuote(out Delim: WideChar; required: Boolean = True);
     procedure Initialize(ASource: TXMLCharSource);
     function DoParseAttValue(Delim: WideChar): Boolean;
     function ContextPush(AEntity: TDOMEntityEx): Boolean;
@@ -382,7 +374,7 @@ type
     procedure StandaloneError(LineOffs: Integer = 0);
     procedure CallErrorHandler(E: EXMLReadError);
     function  FindOrCreateElDef: TDOMElementDef;
-    function  SkipUntilSeq(const Delim: TSetOfChar; const More: array of WideChar): Boolean;
+    function  SkipUntilSeq(const Delim: TSetOfChar; c1: WideChar; c2: WideChar = #0): Boolean;
     procedure CheckMaxChars;
   protected
     FCursor: TDOMNode_WithChildren;
@@ -408,7 +400,6 @@ type
     function  ExpectName: WideString;                                   // [5]
     procedure SkipQuotedLiteral(out Literal: WideString; required: Boolean = True);
     procedure ExpectAttValue;                                           // [10]
-    procedure SkipPubidLiteral(out Literal: WideString);                // [12]
     procedure ParseComment;                                             // [15]
     procedure ParsePI;                                                  // [16]
     procedure ParseCDSect;                                              // [18]
@@ -435,11 +426,10 @@ type
     procedure ExpectChoiceOrSeq(CP: TContentParticle);
     procedure ParseElementDecl;
     procedure ParseNotationDecl;
-    function ResolveEntity(const AbsSysID, PublicID: WideString; out Source: TXMLCharSource): Boolean;
+    function ResolveEntity(const SystemID, PublicID, BaseURI: WideString; out Source: TXMLCharSource): Boolean;
     procedure ProcessDefaultAttributes(Element: TDOMElement; Map: TDOMNamedNodeMap);
     procedure ProcessNamespaceAtts(Element: TDOMElement);
-    procedure AddBinding(Attr: TDOMAttr; Prefix: PHashItem; var Chain: TBinding);
-    procedure EndNamespaceScope(var Chain: TBinding);
+    procedure AddBinding(Attr: TDOMAttr; PrefixPtr: PWideChar; PrefixLen: Integer);
 
     procedure PushVC(aElement: TDOMElement; aElDef: TDOMElementDef);
     procedure PopVC;
@@ -696,6 +686,30 @@ begin
     CompareMem(ABuf.Buffer, Pointer(Arg), ABuf.Length*sizeof(WideChar));
 end;
 
+{ TDOMParseOptions }
+
+function TDOMParseOptions.GetCanonical: Boolean;
+begin
+  Result := FCanonical and FExpandEntities and FCDSectionsAsText and
+  { (not normalizeCharacters) and } FNamespaces and
+  { namespaceDeclarations and } FPreserveWhitespace;
+end;
+
+procedure TDOMParseOptions.SetCanonical(aValue: Boolean);
+begin
+  FCanonical := aValue;
+  if aValue then
+  begin
+    FExpandEntities := True;
+    FCDSectionsAsText := True;
+    FNamespaces := True;
+    FPreserveWhitespace := True;
+    { normalizeCharacters := False; }
+    { namespaceDeclarations := True; }
+    { wellFormed := True; }
+  end;
+end;
+
 { TXMLInputSource }
 
 constructor TXMLInputSource.Create(AStream: TStream);
@@ -744,7 +758,7 @@ begin
   ADoc := nil;
   with TXMLReader.Create(Self) do
   try
-    if ResolveEntity(URI, '', Src) then
+    if ResolveEntity(URI, '', '', Src) then
       ProcessXML(Src)
     else
       DoErrorPos(esFatal, 'The specified URI could not be resolved', NullLocation);
@@ -819,16 +833,6 @@ begin
   Result := True; // always succeed
 end;
 
-function TXMLCharSource.GetPublicID: WideString;
-begin
-  if FPublicID <> '' then
-    Result := FPublicID
-  else if Assigned(FParent) then
-    Result := FParent.PublicID
-  else
-    Result := '';
-end;
-
 function TXMLCharSource.GetSystemID: WideString;
 begin
   if FSystemID <> '' then
@@ -879,7 +883,11 @@ begin
   if (FBufEnd >= FBuf + Length(arg)) or Reload then
     Result := CompareMem(Pointer(arg), FBuf, Length(arg)*sizeof(WideChar));
   if Result then
+  begin
     Inc(FBuf, Length(arg));
+    if FBuf >= FBufEnd then
+      Reload;
+  end;
 end;
 
 { TXMLDecodingSource }
@@ -1164,7 +1172,7 @@ begin
     else if SrcIn.FStringData <> '' then
       SrcOut := TXMLStreamInputSource.Create(TStringStream.Create(SrcIn.FStringData), True)
     else if (SrcIn.SystemID <> '') then
-      ResolveEntity(SrcIn.SystemID, SrcIn.PublicID, SrcOut);
+      ResolveEntity(SrcIn.SystemID, SrcIn.PublicID, SrcIn.BaseURI, SrcOut);
   end;
   if (SrcOut = nil) and (FSource = nil) then
     DoErrorPos(esFatal, 'No input source specified', NullLocation);
@@ -1176,14 +1184,17 @@ begin
   Loc.LinePos := FSource.FBuf-FSource.LFPos;
 end;
 
-function TXMLReader.ResolveEntity(const AbsSysID, PublicID: WideString; out Source: TXMLCharSource): Boolean;
+function TXMLReader.ResolveEntity(const SystemID, PublicID, BaseURI: WideString; out Source: TXMLCharSource): Boolean;
 var
+  AbsSysID: WideString;
   Filename: string;
   Stream: TStream;
   fd: THandle;
 begin
   Source := nil;
   Result := False;
+  if not ResolveRelativeURI(BaseURI, SystemID, AbsSysID) then
+    Exit;
   { TODO: alternative resolvers
     These may be 'internal' resolvers or a handler set by application.
     Internal resolvers should probably produce a TStream
@@ -1199,7 +1210,6 @@ begin
       Stream := THandleOwnerStream.Create(fd);
       Source := TXMLStreamInputSource.Create(Stream, True);
       Source.SystemID := AbsSysID;    // <- Revisit: Really need absolute sysID?
-      Source.PublicID := PublicID;
     end;
   end;
   Result := Assigned(Source);
@@ -1213,11 +1223,6 @@ begin
   FSource.Initialize;
 end;
 
-procedure TXMLReader.RaiseExpectedQmark;
-begin
-  FatalError('Expected single or double quote');
-end;
-
 procedure TXMLReader.FatalError(Expected: WideChar);
 begin
 // FIX: don't output what is found - anything may be found, including exploits...
@@ -1258,9 +1263,15 @@ end;
 procedure TXMLReader.DoErrorPos(Severity: TErrorSeverity; const descr: string; const ErrPos: TLocation);
 var
   E: EXMLReadError;
+  sysid: WideString;
 begin
   if Assigned(FSource) then
-    E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, ErrPos.Line, ErrPos.LinePos, descr])
+  begin
+    sysid := FSource.FSystemID;
+    if (sysid = '') and Assigned(FSource.FEntity) then
+      sysid := TDOMEntityEx(FSource.FEntity).FURI;
+    E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [sysid, ErrPos.Line, ErrPos.LinePos, descr]);
+  end
   else
     E := EXMLReadError.Create(descr);
   E.FSeverity := Severity;
@@ -1393,12 +1404,22 @@ begin
   end;  
 end;
 
+procedure TXMLReader.SkipQuote(out Delim: WideChar; required: Boolean);
+begin
+  Delim := #0;
+  if (FSource.FBuf^ = '''') or (FSource.FBuf^ = '"') then
+  begin
+    Delim := FSource.FBuf^;
+    FSource.NextChar;  // skip quote
+  end
+  else if required then
+    FatalError('Expected single or double quote');
+end;
+
 const
   PrefixDefault: array[0..4] of WideChar = ('x','m','l','n','s');
 
 constructor TXMLReader.Create;
-var
-  b: TBinding;
 begin
   inherited Create;
   BufAllocate(FName, 128);
@@ -1406,20 +1427,12 @@ begin
   FIDRefs := TFPList.Create;
   FNotationRefs := TFPList.Create;
 
-  FPrefixes := THashTable.Create(16, False);
-  FBindings := TFPList.Create;
+  FNSHelper := TNSSupport.Create;
+
   FNsAttHash := TDblHashArray.Create;
   SetLength(FWorkAtts, 16);
-  SetLength(FBindingStack, 16);
-  FStdPrefix_xml := FPrefixes.FindOrAdd(@PrefixDefault, 3);
-  FStdPrefix_xmlns := FPrefixes.FindOrAdd(@PrefixDefault, 5);
-  { implicit binding for the 'xml' prefix }
-  b := TBinding.Create;
-  FBindings.Add(b);
-  FStdPrefix_xml^.Data := b;
-  b.uri := stduri_xml;
-  b.Prefix := FStdPrefix_xml;
-
+  FStdPrefix_xml := FNSHelper.GetPrefix(@PrefixDefault, 3);
+  FStdPrefix_xmlns := FNSHelper.GetPrefix(@PrefixDefault, 5);
   // Set char rules to XML 1.0
   FNamePages := @NamePages;
   SetLength(FValidator, 16);
@@ -1437,12 +1450,11 @@ begin
   FResolveExternals := FCtrl.Options.ResolveExternals;
   FNamespaces := FCtrl.Options.Namespaces;
   FDisallowDoctype := FCtrl.Options.DisallowDoctype;
+  FCanonical := FCtrl.Options.CanonicalForm;
   FMaxChars := FCtrl.Options.MaxChars;
 end;
 
 destructor TXMLReader.Destroy;
-var
-  I: Integer;
 begin
   if Assigned(FEntityValue.Buffer) then
     FreeMem(FEntityValue.Buffer);
@@ -1455,10 +1467,10 @@ begin
   ClearRefs(FNotationRefs);
   ClearRefs(FIDRefs);
   FNsAttHash.Free;
-  for I := FBindings.Count-1 downto 0 do
-    TObject(FBindings.List^[I]).Free;
-  FPrefixes.Free;
-  FBindings.Free;
+  FNSHelper.Free;
+  if FOwnsDoctype then
+    FDocType.Free;
+
   FNotationRefs.Free;
   FIDRefs.Free;
   inherited Destroy;
@@ -1732,7 +1744,7 @@ var
 begin
   if (AEntity.SystemID <> '') and not AEntity.FResolved then
   begin
-    Result := ResolveEntity(AEntity.FURI, AEntity.PublicID, Src);
+    Result := ResolveEntity(AEntity.SystemID, AEntity.PublicID, AEntity.FURI, Src);
     if not Result then
     begin
       // TODO: a detailed message like SysErrorMessage(GetLastError) would be great here 
@@ -1743,10 +1755,11 @@ begin
   else
   begin
     Src := TXMLCharSource.Create(AEntity.FReplacementText);
-    // needed in case of prefetched external PE
-    Src.SystemID := AEntity.FURI;
     Src.FLineNo := AEntity.FStartLocation.Line;
     Src.LFPos := Src.FBuf - AEntity.FStartLocation.LinePos;
+    // needed in case of prefetched external PE
+    if AEntity.SystemID <> '' then
+      Src.SystemID := AEntity.FURI;
   end;
 
   AEntity.FOnStack := True;
@@ -1884,6 +1897,7 @@ begin
       PEnt.FCharCount := FValue.Length;
       PEnt.FStartLocation.Line := 1;
       PEnt.FStartLocation.LinePos := 1;
+      PEnt.FURI := FSource.SystemID;    // replace base URI with absolute one
     finally
       ContextPop;
       PEnt.FResolved := True;
@@ -1903,10 +1917,7 @@ procedure TXMLReader.ExpectAttValue;    // [10]
 var
   Delim: WideChar;
 begin
-  if (FSource.FBuf^ <> '''') and (FSource.FBuf^ <> '"') then
-    RaiseExpectedQmark;
-  Delim := FSource.FBuf^;
-  FSource.NextChar;  // skip quote
+  SkipQuote(Delim);
   StoreLocation(FTokenStart);
   if not DoParseAttValue(Delim) then
     FatalError('Literal has no closing quote',-1);
@@ -1916,10 +1927,9 @@ procedure TXMLReader.SkipQuotedLiteral(out Literal: WideString; required: Boolea
 var
   Delim: WideChar;
 begin
-  if (FSource.FBuf^ = '''') or (FSource.FBuf^ = '"') then
+  SkipQuote(Delim, required);
+  if Delim <> #0 then
   begin
-    Delim := FSource.FBuf^;
-    FSource.NextChar;  // skip quote
     StoreLocation(FTokenStart);
     FValue.Length := 0;
     if Delim = '''' then
@@ -1930,32 +1940,12 @@ begin
       FatalError('Literal has no closing quote', -1);
     FSource.NextChar;
     SetString(Literal, FValue.Buffer, FValue.Length);
-  end
-  else if required then
-    RaiseExpectedQMark;
-end;
-
-procedure TXMLReader.SkipPubidLiteral(out Literal: WideString);         // [12]
-var
-  I: Integer;
-  wc: WideChar;
-begin
-  SkipQuotedLiteral(Literal);
-  for I := 1 to Length(Literal) do
-  begin
-    wc := Literal[I];
-    if (wc > #255) or not (Char(ord(wc)) in PubidChars) then
-      FatalError('Illegal Public ID literal', -1);
-    if (wc = #10) or (wc = #13) then
-      Literal[I] := #32;
   end;
 end;
 
-function TXMLReader.SkipUntilSeq(const Delim: TSetOfChar; const More: array of WideChar): Boolean;
+function TXMLReader.SkipUntilSeq(const Delim: TSetOfChar; c1: WideChar; c2: WideChar = #0): Boolean;
 var
-  I: Integer;
   wc: WideChar;
-  Match: Boolean;
 begin
   Result := False;
   FValue.Length := 0;
@@ -1965,18 +1955,12 @@ begin
     if wc <> #0 then
     begin
       FSource.NextChar;
-      if (FValue.Length > High(More)) then
+      if (FValue.Length > ord(c2 <> #0)) then
       begin
-        Match := True;
-        for I := High(More) downto Low(More) do
-          if FValue.Buffer[FValue.Length - (High(More)+1) + I] <> More[I] then
-          begin
-            Match := False;
-            Break;
-          end;
-        if Match then
+        if (FValue.Buffer[FValue.Length-1] = c1) and
+          ((c2 = #0) or ((c2 <> #0) and (FValue.Buffer[FValue.Length-2] = c2))) then
         begin
-          Dec(FValue.Length, High(More)+1);
+          Dec(FValue.Length, ord(c2 <> #0) + 1);
           Result := True;
           Exit;
         end;
@@ -1986,15 +1970,10 @@ begin
   until wc = #0;
 end;
 
-const
-  CommentEnd: array[0..0] of WideChar = ('-');
-  PIEnd:      array[0..0] of WideChar = ('?');
-  CDEnd:      array[0..1] of WideChar = (']',']');
-
 procedure TXMLReader.ParseComment;    // [15]
 begin
   ExpectString('--');
-  if SkipUntilSeq([#0, '-'], CommentEnd) then
+  if SkipUntilSeq([#0, '-'], '-') then
   begin
     ExpectChar('>');
     DoComment(FValue.Buffer, FValue.Length);
@@ -2026,7 +2005,7 @@ begin
   if FSource.FBuf^ <> '?' then
     SkipS(True);
 
-  if SkipUntilSeq(GT_Delim, PIEnd) then
+  if SkipUntilSeq(GT_Delim, '?') then
   begin
     SetString(Value, FValue.Buffer, FValue.Length);
     // SAX: ContentHandler.ProcessingInstruction(Name, Value);
@@ -2043,75 +2022,102 @@ begin
     FatalError('Unterminated processing instruction', -1);
 end;
 
+const
+  verStr: array[Boolean] of WideString = ('1.0', '1.1');
+
 procedure TXMLReader.ParseXmlOrTextDecl(TextDecl: Boolean);
 var
   TmpStr: WideString;
   IsXML11: Boolean;
+  Delim: WideChar;
+  buf: array[0..31] of WideChar;
+  I: Integer;
 begin
   SkipS(True);
-  // VersionInfo: optional in TextDecl, required in XmlDecl
+  // [24] VersionInfo: optional in TextDecl, required in XmlDecl
   if (not TextDecl) or (FSource.FBuf^ = 'v') then
   begin
-    ExpectString('version');                              // [24]
+    ExpectString('version');
     ExpectEq;
-    SkipQuotedLiteral(TmpStr);
-    IsXML11 := False;
-    if TmpStr = '1.1' then     // Checking for bad chars is implied
-      IsXML11 := True
-    else if TmpStr <> '1.0' then
-    { should be no whitespace in these literals, but that isn't checked now }
+    SkipQuote(Delim);
+    StoreLocation(FTokenStart);
+    I := 0;
+    while (I < 3) and (FSource.FBuf^ <> Delim) do
+    begin
+      buf[I] := FSource.FBuf^;
+      Inc(I);
+      FSource.NextChar;
+    end;
+    if (I <> 3) or (buf[0] <> '1') or (buf[1] <> '.') or
+      ((buf[2] <> '0') and (buf[2] <> '1')) then
       FatalError('Illegal version number', -1);
 
+    ExpectChar(Delim);
+    IsXML11 := buf[2] = '1';
+
     if not TextDecl then
     begin
       if doc.InheritsFrom(TXMLDocument) then
-        TXMLDocument(doc).XMLVersion := TmpStr;
-      if IsXML11 then
-        XML11_BuildTables;
+        TXMLDocument(doc).XMLVersion := verStr[IsXML11];  // buf[0..2] works with FPC only
     end
     else   // parsing external entity
       if IsXML11 and not FXML11 then
         FatalError('XML 1.0 document cannot invoke XML 1.1 entities', -1);
 
-    if FSource.FBuf^ <> '?' then
+    if TextDecl or (FSource.FBuf^ <> '?') then
       SkipS(True);
   end;
 
-  // EncodingDecl: required in TextDecl, optional in XmlDecl
-  if TextDecl or (FSource.FBuf^ = 'e') then                    // [80]
+  // [80] EncodingDecl: required in TextDecl, optional in XmlDecl
+  if TextDecl or (FSource.FBuf^ = 'e') then
   begin
     ExpectString('encoding');
     ExpectEq;
-    SkipQuotedLiteral(TmpStr);
-
-    if not IsValidXmlEncoding(TmpStr) then
-      FatalError('Illegal encoding name', -1);
+    SkipQuote(Delim);
+    I := 0;
+    while (I < 30) and (FSource.FBuf^ <> Delim) and (FSource.FBuf^ < #127) and
+      ((Char(ord(FSource.FBuf^)) in ['A'..'Z', 'a'..'z']) or
+      ((I > 0) and (Char(ord(FSource.FBuf^)) in ['0'..'9', '.', '-', '_']))) do
+    begin
+      buf[I] := FSource.FBuf^;
+      Inc(I);
+      FSource.NextChar;
+    end;
+    if not CheckForChar(Delim) then
+      FatalError('Illegal encoding name', i);
 
+    SetString(TmpStr, buf, i);
     if not FSource.SetEncoding(TmpStr) then  // <-- Wide2Ansi conversion here
-      FatalError('Encoding ''%s'' is not supported', [TmpStr], -1);
+      FatalError('Encoding ''%s'' is not supported', [TmpStr], i+1);
     // getting here means that specified encoding is supported
     // TODO: maybe assign the 'preferred' encoding name?
     if not TextDecl and doc.InheritsFrom(TXMLDocument) then
       TXMLDocument(doc).Encoding := TmpStr;
 
     if FSource.FBuf^ <> '?' then
-      SkipS(True);
+      SkipS(not TextDecl);
   end;
 
-  // SDDecl: forbidden in TextDecl, optional in XmlDecl
+  // [32] SDDecl: forbidden in TextDecl, optional in XmlDecl
   if (not TextDecl) and (FSource.FBuf^ = 's') then
   begin
     ExpectString('standalone');
     ExpectEq;
-    SkipQuotedLiteral(TmpStr);
-    if TmpStr = 'yes' then
+    SkipQuote(Delim);
+    StoreLocation(FTokenStart);
+    if FSource.Matches('yes') then
       FStandalone := True
-    else if TmpStr <> 'no' then
+    else if not FSource.Matches('no') then
       FatalError('Only "yes" or "no" are permitted as values of "standalone"', -1);
+    ExpectChar(Delim);
     SkipS;
   end;
 
   ExpectString('?>');
+  { Switch to 1.1 rules only after declaration is parsed completely. This is to
+    ensure that NEL and LSEP within declaration are rejected (rmt-056, rmt-057) }
+  if (not TextDecl) and IsXML11 then
+    XML11_BuildTables;
 end;
 
 procedure TXMLReader.DTDReloadHook;
@@ -2136,7 +2142,6 @@ end;
 procedure TXMLReader.ParseDoctypeDecl;    // [28]
 var
   Src: TXMLCharSource;
-  DoctypeURI: WideString;
 begin
   if FState >= rsDTD then
     FatalError('Markup declaration is not allowed here');
@@ -2155,7 +2160,10 @@ begin
     SkipS;
   finally
     // DONE: append node after its name has been set; always append to avoid leak
-    Doc.AppendChild(FDocType);
+    if FCanonical then
+      FOwnsDoctype := True
+    else
+      Doc.AppendChild(FDocType);
     FCursor := nil;
   end;
 
@@ -2179,8 +2187,7 @@ begin
 
   if (FDocType.SystemID <> '') then
   begin
-    ResolveRelativeURI(FSource.SystemID, FDocType.SystemID, DoctypeURI);
-    if ResolveEntity(DocTypeURI, FDocType.PublicID, Src) then
+    if ResolveEntity(FDocType.SystemID, FDocType.PublicID, FSource.SystemID, Src) then
     begin
       Initialize(Src);
       try
@@ -2606,6 +2613,8 @@ begin
     CheckNCName;
     ExpectWhitespace;
 
+    // remember where the entity is declared
+    Entity.FURI := FSource.SystemID;
     if (FSource.FBuf^ = '"') or (FSource.FBuf^ = '''') then
     begin
       NDataAllowed := False;
@@ -2617,14 +2626,8 @@ begin
       SetString(Entity.FReplacementText, FEntityValue.Buffer, FEntityValue.Length);
       Entity.FCharCount := FEntityValue.Length;
     end
-    else
-    begin
-      if not ParseExternalID(Entity.FSystemID, Entity.FPublicID, False) then
-        FatalError('Expected entity value or external ID');
-      { need to resolve entity's SystemID relative to the current source,
-        which may differ from the source at the point of inclusion }
-      ResolveRelativeURI(FSource.SystemID, Entity.SystemID, Entity.FURI);
-    end;
+    else if not ParseExternalID(Entity.FSystemID, Entity.FPublicID, False) then
+      FatalError('Expected entity value or external ID');
 
     if NDataAllowed then                // [76]
     begin
@@ -2726,11 +2729,10 @@ begin
             else if FSource.Matches(']]>') then
               Dec(IgnoreLevel)
             else if wc <> #0 then
-              FSource.NextChar;
-          until (IgnoreLevel=0) or (wc = #0);
-// Since PE's are not recognized in ignore sections, reaching EOF is fatal.
-          if wc = #0 then
-            Break;
+              FSource.NextChar
+            else // PE's aren't recognized in ignore section, cannot ContextPop()
+              DoErrorPos(esFatal, 'IGNORE section is not closed', IgnoreLoc);
+          until IgnoreLevel=0;
         end;
       end
       else
@@ -2759,14 +2761,8 @@ begin
     end;
   until False;
   FRecognizePE := False;
-  if (IncludeLevel > 0) or (IgnoreLevel > 0) then
-  begin
-    if IncludeLevel > 0 then
-      FTokenStart := IncludeLoc
-    else
-      FTokenStart := IgnoreLoc;
-    FatalError('Conditional section is not closed', -1);
-  end;
+  if IncludeLevel > 0 then
+    DoErrorPos(esFatal, 'INCLUDE section is not closed', IncludeLoc);
   if (FSource.DTDSubsetType = dsInternal) and (FSource.FBuf^ = ']') then
     Exit;
   if FSource.FBuf^ <> #0 then
@@ -2789,7 +2785,7 @@ begin
   ExpectString('[CDATA[');
   if FState <> rsRoot then
     FatalError('Illegal at document level');
-  if SkipUntilSeq(GT_Delim, CDEnd) then
+  if SkipUntilSeq(GT_Delim, ']', ']') then
     DoCDSect(FValue.Buffer, FValue.Length)
   else
     FatalError('Unterminated CDATA section', -1);
@@ -3025,7 +3021,7 @@ begin
     ValidationError('Element ''%s'' is missing required sub-elements', [NewElem.NSI.QName^.Key], ErrOffset);
 
   if FNamespaces then
-    EndNamespaceScope(FBindingStack[FNesting]);
+    FNSHelper.EndElement;
   PopVC;
 end;
 
@@ -3173,12 +3169,13 @@ begin
 end;
 
 
-procedure TXMLReader.AddBinding(Attr: TDOMAttr; Prefix: PHashItem; var Chain: TBinding);
+procedure TXMLReader.AddBinding(Attr: TDOMAttr; PrefixPtr: PWideChar; PrefixLen: Integer);
 var
   nsUri: DOMString;
-  b: TBinding;
+  Prefix: PHashItem;
 begin
   nsUri := Attr.NodeValue;
+  Prefix := FNSHelper.GetPrefix(PrefixPtr, PrefixLen);
   { 'xml' is allowed to be bound to the correct namespace }
   if ((nsUri = stduri_xml) <> (Prefix = FStdPrefix_xml)) or
    (Prefix = FStdPrefix_xmlns) or
@@ -3190,45 +3187,10 @@ begin
       FatalError('Illegal usage of reserved namespace URI ''%s''', [nsUri]);
   end;
 
-  { try reusing an existing binding }
-  b := FFreeBindings;
-  if Assigned(b) then
-    FFreeBindings := b.Next
-  else { no free bindings, create a new one }
-  begin
-    b := TBinding.Create;
-    FBindings.Add(b);
-  end;
+  if (nsUri = '') and not (FXML11 or (Prefix^.Key = '')) then
+    FatalError('Illegal undefining of namespace');  { position - ? }
 
-  b.uri := nsUri;
-  b.prefix := Prefix;
-  b.PrevPrefixBinding := Prefix^.Data;
-  if nsUri = '' then
-  begin
-    if (FXML11 or (Prefix = @FDefaultPrefix)) then // prefix being unbound
-      Prefix^.Data := nil
-    else
-      FatalError('Illegal undefining of namespace');  { position - ? }
-  end
-  else
-    Prefix^.Data := b;
-
-  b.Next := Chain;
-  Chain := b;
-end;
-
-procedure TXMLReader.EndNamespaceScope(var Chain: TBinding);
-var
-  b: TBinding;
-begin
-  while Assigned(Chain) do
-  begin
-    b := Chain;
-    Chain := b.next;
-    b.next := FFreeBindings;
-    FFreeBindings := b;
-    b.Prefix^.Data := b.prevPrefixBinding;
-  end;  
+  FNSHelper.BindPrefix(nsURI, Prefix);
 end;
 
 procedure TXMLReader.ProcessNamespaceAtts(Element: TDOMElement);
@@ -3240,8 +3202,8 @@ var
   PrefixCount: Integer;
   b: TBinding;
 begin
-  if FNesting = Length(FBindingStack) then
-    SetLength(FBindingStack, FNesting * 2);
+  FNSHelper.StartElement;
+
   PrefixCount := 0;
   if Element.HasAttributes then
   begin
@@ -3260,13 +3222,12 @@ begin
         begin
           // TODO: check all consequences of having zero PrefixLength
           Attr.SetNSI(stduri_xmlns, 0);
-          AddBinding(Attr, @FDefaultPrefix, FBindingStack[FNesting]);
+          AddBinding(Attr, nil, 0);
         end
         else if AttrName^.Key[6] = ':' then
         begin
-          Prefix := FPrefixes.FindOrAdd(@AttrName^.Key[7], Length(AttrName^.Key)-6);
           Attr.SetNSI(stduri_xmlns, 6);
-          AddBinding(Attr, Prefix, FBindingStack[FNesting]);
+          AddBinding(Attr, @AttrName^.Key[7], Length(AttrName^.Key)-6);
         end;
       end
       else
@@ -3287,15 +3248,15 @@ begin
     FNsAttHash.Init(PrefixCount);
     for I := 0 to PrefixCount-1 do
     begin
-      AttrName := FWorkAtts[I].Attr.NSI.QName;    
-      Prefix := FPrefixes.FindOrAdd(PWideChar(AttrName^.Key), FWorkAtts[I].PrefixLen-1);
-      b := TBinding(Prefix^.Data);
-      if b = nil then
+      AttrName := FWorkAtts[I].Attr.NSI.QName;
+      if not FNSHelper.IsPrefixBound(PWideChar(AttrName^.Key), FWorkAtts[I].PrefixLen-1, Prefix) then
         FatalError('Unbound prefix "%s"', [Prefix^.Key]);
+
+      b := TBinding(Prefix^.Data);
       { detect duplicates }
       J := FWorkAtts[I].PrefixLen+1;
 
-      if FNsAttHash.Locate(@b.uri, @AttrName^.Key[J], Length(AttrName^.Key) - J) then
+      if FNsAttHash.Locate(@b.uri, @AttrName^.Key[J], Length(AttrName^.Key) - J+1) then
         FatalError('Duplicate prefixed attribute');
 
       // convert Attr into namespaced one (by hack for the time being)
@@ -3306,21 +3267,24 @@ begin
   J := Pos(WideChar(':'), Element.NSI.QName^.Key);
   if J > 1 then
   begin
-    Prefix := FPrefixes.FindOrAdd(PWideChar(Element.NSI.QName^.Key), J-1);
-    if Prefix^.Data = nil then
+    if not FNSHelper.IsPrefixBound(PWideChar(Element.NSI.QName^.Key), J-1, Prefix) then
       FatalError('Unbound prefix "%s"', [Prefix^.Key]);
     b := TBinding(Prefix^.Data);
+    Element.SetNSI(b.uri, J);
   end
-  else if Assigned(FDefaultPrefix.Data) then
-    b := TBinding(FDefaultPrefix.Data)
   else
-    Exit;
-  // convert Element into namespaced one (by hack for the time being)
-  Element.SetNSI(b.uri, J);
+  begin
+    b := FNSHelper.DefaultNSBinding;
+    if Assigned(b) then
+      Element.SetNSI(b.uri, 0);
+  end;
 end;
 
 function TXMLReader.ParseExternalID(out SysID, PubID: WideString;     // [75]
   SysIdOptional: Boolean): Boolean;
+var
+  I: Integer;
+  wc: WideChar;
 begin
   if FSource.Matches('SYSTEM') then
   begin
@@ -3331,7 +3295,15 @@ begin
   else if FSource.Matches('PUBLIC') then
   begin
     ExpectWhitespace;
-    SkipPubidLiteral(PubID);
+    SkipQuotedLiteral(PubID);
+    for I := 1 to Length(PubID) do
+    begin
+      wc := PubID[I];
+      if (wc > #255) or not (Char(ord(wc)) in PubidChars) then
+        FatalError('Illegal Public ID literal', -1);
+      if (wc = #10) or (wc = #13) then
+        PubID[I] := #32;
+    end;
     NormalizeSpaces(PubID);
     if SysIdOptional then
       SkipWhitespace

packages/fcl-xml/src/xmlutils.pp

@@ -16,11 +16,12 @@ unit xmlutils;
 
 {$ifdef fpc}{$mode objfpc}{$endif}
 {$H+}
+{$ifopt Q+}{$define overflow_check}{$endif}
 
 interface
 
 uses
-  SysUtils;
+  SysUtils, Classes;
 
 function IsXmlName(const Value: WideString; Xml11: Boolean = False): Boolean; overload;
 function IsXmlName(Value: PWideChar; Len: Integer; Xml11: Boolean = False): Boolean; overload;
@@ -40,6 +41,7 @@ function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
 type
 {$ifndef fpc}
   PtrInt = LongInt;
+  TFPList = TList;
 {$endif}  
 
   PPHashItem = ^PHashItem;
@@ -50,7 +52,7 @@ type
     Next: PHashItem;
     Data: TObject;
   end;
-  THashItemArray = array[0..0] of PHashItem;
+  THashItemArray = array[0..MaxInt div sizeof(Pointer)-1] of PHashItem;
   PHashItemArray = ^THashItemArray;
 
   THashForEach = function(Entry: PHashItem; arg: Pointer): Boolean;
@@ -86,7 +88,7 @@ type
     lname: PWideChar;
     lnameLen: Integer;
   end;
-  TExpHashEntryArray = array[0..0] of TExpHashEntry;
+  TExpHashEntryArray = array[0..MaxInt div sizeof(TExpHashEntry)-1] of TExpHashEntry;
   PExpHashEntryArray = ^TExpHashEntryArray;
 
   TDblHashArray = class(TObject)
@@ -100,6 +102,43 @@ type
     destructor Destroy; override;
   end;
 
+  TBinding = class
+  public
+    uri: WideString;
+    next: TBinding;
+    prevPrefixBinding: TObject;
+    Prefix: PHashItem;
+  end;
+
+  TAttributeAction = (
+    aaUnchanged,
+    aaPrefix,         // only override the prefix
+    aaBoth            // override prefix and emit namespace definition
+  );
+
+  TNSSupport = class(TObject)
+  private
+    FNesting: Integer;
+    FPrefixSeqNo: Integer;
+    FFreeBindings: TBinding;
+    FBindings: TFPList;
+    FBindingStack: array of TBinding;
+    FPrefixes: THashTable;
+    FDefaultPrefix: THashItem;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure DefineBinding(const Prefix, nsURI: WideString; out Binding: TBinding);
+    function CheckAttribute(const Prefix, nsURI: WideString;
+      out Binding: TBinding): TAttributeAction;
+    function IsPrefixBound(P: PWideChar; Len: Integer; out Prefix: PHashItem): Boolean;
+    function GetPrefix(P: PWideChar; Len: Integer): PHashItem;
+    function BindPrefix(const nsURI: WideString; aPrefix: PHashItem): TBinding;
+    function DefaultNSBinding: TBinding;
+    procedure StartElement;
+    procedure EndElement;
+  end;
+
 {$i names.inc}
 
 implementation
@@ -345,7 +384,9 @@ begin
   Result := InitValue;
   while KeyLen <> 0 do
   begin
+{$ifdef overflow_check}{$q-}{$endif}
     Result := Result * $F4243 xor ord(Key^);
+{$ifdef overflow_check}{$q+}{$endif}
     Inc(Key);
     Dec(KeyLen);
   end;
@@ -440,7 +481,7 @@ var
   h: LongWord;
 begin
   h := Hash(0, Key, KeyLength);
-  Entry := @FBucket[h mod FBucketCount];
+  Entry := @FBucket^[h mod FBucketCount];
   while Assigned(Entry^) and not ((Entry^^.HashValue = h) and KeyCompare(Entry^^.Key, Key, KeyLength) ) do
     Entry := @Entry^^.Next;
   Found := Assigned(Entry^);
@@ -457,8 +498,7 @@ begin
   else
   begin
     New(Result);
-    // SetString for WideStrings trims on zero chars
-    // need to investigate and report
+    // SetString for WideStrings trims on zero chars [fixed, #14740]
     SetLength(Result^.Key, KeyLength);
     Move(Key^, Pointer(Result^.Key)^, KeyLength*sizeof(WideChar));
     Result^.HashValue := h;
@@ -482,7 +522,7 @@ begin
     e := FBucket^[i];
     while Assigned(e) do
     begin
-      chain := @p[e^.HashValue mod NewCapacity];
+      chain := @p^[e^.HashValue mod NewCapacity];
       n := e^.Next;
       e^.Next := chain^;
       chain^ := e;
@@ -498,7 +538,7 @@ function THashTable.Remove(Entry: PHashItem): Boolean;
 var
   chain: PPHashItem;
 begin
-  chain := @FBucket[Entry^.HashValue mod FBucketCount];
+  chain := @FBucket^[Entry^.HashValue mod FBucketCount];
   while Assigned(chain^) do
   begin
     if chain^ = Entry then
@@ -525,7 +565,7 @@ var
 begin
   for i := 0 to FBucketCount-1 do
   begin
-    chain := @FBucket[i];
+    chain := @FBucket^[i];
     while Assigned(chain^) do
     begin
       if chain^^.Data = aData then
@@ -625,6 +665,172 @@ begin
   result := False;
 end;
 
+{ TNSSupport }
+
+constructor TNSSupport.Create;
+var
+  b: TBinding;
+begin
+  inherited Create;
+  FPrefixes := THashTable.Create(16, False);
+  FBindings := TFPList.Create;
+  SetLength(FBindingStack, 16);
+
+  { provide implicit binding for the 'xml' prefix }
+  // TODO: move stduri_xml, etc. to this unit, so they are reused.
+  DefineBinding('xml', 'http://www.w3.org/XML/1998/namespace', b);
+end;
+
+destructor TNSSupport.Destroy;
+var
+  I: Integer;
+begin
+  for I := FBindings.Count-1 downto 0 do
+    TObject(FBindings.List^[I]).Free;
+  FBindings.Free;
+  FPrefixes.Free;
+  inherited Destroy;
+end;
+
+function TNSSupport.BindPrefix(const nsURI: WideString; aPrefix: PHashItem): TBinding;
+begin
+  { try to reuse an existing binding }
+  result := FFreeBindings;
+  if Assigned(result) then
+    FFreeBindings := result.Next
+  else { no free bindings, create a new one }
+  begin
+    result := TBinding.Create;
+    FBindings.Add(result);
+  end;
+
+  { link it into chain of bindings at the current element level }
+  result.Next := FBindingStack[FNesting];
+  FBindingStack[FNesting] := result;
+
+  { bind }
+  result.uri := nsURI;
+  result.Prefix := aPrefix;
+  result.PrevPrefixBinding := aPrefix^.Data;
+  aPrefix^.Data := result;
+end;
+
+function TNSSupport.DefaultNSBinding: TBinding;
+begin
+  result := TBinding(FDefaultPrefix.Data);
+end;
+
+procedure TNSSupport.DefineBinding(const Prefix, nsURI: WideString;
+  out Binding: TBinding);
+var
+  Pfx: PHashItem;
+begin
+  Pfx := @FDefaultPrefix;
+  if (nsURI <> '') and (Prefix <> '') then
+    Pfx := FPrefixes.FindOrAdd(PWideChar(Prefix), Length(Prefix));
+  if (Pfx^.Data = nil) or (TBinding(Pfx^.Data).uri <> nsURI) then
+    Binding := BindPrefix(nsURI, Pfx)
+  else
+    Binding := nil;
+end;
+
+function TNSSupport.CheckAttribute(const Prefix, nsURI: WideString;
+  out Binding: TBinding): TAttributeAction;
+var
+  Pfx: PHashItem;
+  I: Integer;
+  b: TBinding;
+  buf: array[0..31] of WideChar;
+  p: PWideChar;
+begin
+  Binding := nil;
+  Pfx := nil;
+  Result := aaUnchanged;
+  if Prefix <> '' then
+    Pfx := FPrefixes.FindOrAdd(PWideChar(Prefix), Length(Prefix))
+  else if nsURI = '' then
+    Exit;
+  { if the prefix is already bound to correct URI, we're done }
+  if Assigned(Pfx) and Assigned(Pfx^.Data) and (TBinding(Pfx^.Data).uri = nsURI) then
+    Exit;
+
+  { see if there's another prefix bound to the target URI }
+  // TODO: should use something faster than linear search
+  for i := FNesting downto 0 do
+  begin
+    b := FBindingStack[i];
+    while Assigned(b) do
+    begin
+      if (b.uri = nsURI) and (b.Prefix <> @FDefaultPrefix) then
+      begin
+        Binding := b;   // found one -> override the attribute's prefix
+        Result := aaPrefix;
+        Exit;
+      end;
+      b := b.Next;
+    end;
+  end;
+  { no prefix, or bound (to wrong URI) -> use generated prefix instead }
+  if (Pfx = nil) or Assigned(Pfx^.Data) then
+  repeat
+    Inc(FPrefixSeqNo);
+    i := FPrefixSeqNo;    // This is just 'NS'+IntToStr(FPrefixSeqNo);
+    p := @Buf[high(Buf)]; // done without using strings
+    while i <> 0 do
+    begin
+      p^ := WideChar(i mod 10+ord('0'));
+      dec(p);
+      i := i div 10;
+    end;
+    p^ := 'S'; dec(p);
+    p^ := 'N';
+    Pfx := FPrefixes.FindOrAdd(p, @Buf[high(Buf)]-p+1);
+  until Pfx^.Data = nil;
+  Binding := BindPrefix(nsURI, Pfx);
+  Result := aaBoth;
+end;
+
+function TNSSupport.IsPrefixBound(P: PWideChar; Len: Integer; out
+  Prefix: PHashItem): Boolean;
+begin
+  Prefix := FPrefixes.FindOrAdd(P, Len);
+  Result := Assigned(Prefix^.Data) and (TBinding(Prefix^.Data).uri <> '');
+end;
+
+function TNSSupport.GetPrefix(P: PWideChar; Len: Integer): PHashItem;
+begin
+  if Assigned(P) and (Len > 0) then
+    Result := FPrefixes.FindOrAdd(P, Len)
+  else
+    Result := @FDefaultPrefix;
+end;
+
+procedure TNSSupport.StartElement;
+begin
+  Inc(FNesting);
+  if FNesting >= Length(FBindingStack) then
+    SetLength(FBindingStack, FNesting * 2);
+end;
+
+procedure TNSSupport.EndElement;
+var
+  b, temp: TBinding;
+begin
+  temp := FBindingStack[FNesting];
+  while Assigned(temp) do
+  begin
+    b := temp;
+    temp := b.next;
+    b.next := FFreeBindings;
+    FFreeBindings := b;
+    b.Prefix^.Data := b.prevPrefixBinding;
+  end;
+  FBindingStack[FNesting] := nil;
+  if FNesting > 0 then
+    Dec(FNesting);
+end;
+
+
 initialization
 
 finalization

packages/fcl-xml/src/xmlwrite.pp

@@ -37,20 +37,33 @@ procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
 
 implementation
 
-uses SysUtils;
+uses SysUtils, xmlutils;
 
 type
-  TSpecialCharCallback = procedure(c: WideChar) of object;
+  TXMLWriter = class;
+  TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString;
+    var idx: Integer);
+
+  PAttrFixup = ^TAttrFixup;
+  TAttrFixup = record
+    Attr: TDOMNode;
+    Prefix: PHashItem;
+  end;
 
   TXMLWriter = class(TObject)
   private
     FInsideTextNode: Boolean;
+    FCanonical: Boolean;
     FIndent: WideString;
     FIndentCount: Integer;
     FBuffer: PChar;
     FBufPos: PChar;
     FCapacity: Integer;
     FLineBreak: string;
+    FNSHelper: TNSSupport;
+    FAttrFixups: TFPList;
+    FScratch: TFPList;
+    FNSDefs: TFPList;
     procedure wrtChars(Src: PWideChar; Length: Integer);
     procedure IncIndent;
     procedure DecIndent; {$IFDEF HAS_INLINE} inline; {$ENDIF}
@@ -60,8 +73,8 @@ type
     procedure wrtQuotedLiteral(const ws: WideString);
     procedure ConvWrite(const s: WideString; const SpecialChars: TSetOfChar;
       const SpecialCharCallback: TSpecialCharCallback);
-    procedure AttrSpecialCharCallback(c: WideChar);
-    procedure TextNodeSpecialCharCallback(c: WideChar);
+    procedure WriteNSDef(B: TBinding);
+    procedure NamespaceFixup(Element: TDOMElement);
   protected
     procedure Write(const Buffer; Count: Longint); virtual; abstract;
     procedure WriteNode(Node: TDOMNode);
@@ -159,10 +172,22 @@ begin
   // Later on, this may be put under user control
   // for now, take OS setting
   FLineBreak := sLineBreak;
+  FNSHelper := TNSSupport.Create;
+  FScratch := TFPList.Create;
+  FNSDefs := TFPList.Create;
+  FAttrFixups := TFPList.Create;
 end;
 
 destructor TXMLWriter.Destroy;
+var
+  I: Integer;
 begin
+  for I := FAttrFixups.Count-1 downto 0 do
+    Dispose(PAttrFixup(FAttrFixups.List^[I]));
+  FAttrFixups.Free;
+  FNSDefs.Free;
+  FScratch.Free;
+  FNSHelper.Free;
   if FBufPos > FBuffer then
     write(FBuffer^, FBufPos-FBuffer);
 
@@ -304,7 +329,7 @@ begin
     if (s[EndPos] < #255) and (Char(ord(s[EndPos])) in SpecialChars) then
     begin
       wrtChars(@s[StartPos], EndPos - StartPos);
-      SpecialCharCallback(s[EndPos]);
+      SpecialCharCallback(Self, s, EndPos);
       StartPos := EndPos + 1;
     end;
     Inc(EndPos);
@@ -319,29 +344,31 @@ const
   ltStr = '&lt;';
   gtStr = '&gt;';
 
-procedure TXMLWriter.AttrSpecialCharCallback(c: WideChar);
+procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
 begin
-  case c of
-    '"': wrtStr(QuotStr);
-    '&': wrtStr(AmpStr);
-    '<': wrtStr(ltStr);
+  case s[idx] of
+    '"': Sender.wrtStr(QuotStr);
+    '&': Sender.wrtStr(AmpStr);
+    '<': Sender.wrtStr(ltStr);
     // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
-    #9: wrtStr('&#x9;');
-    #10: wrtStr('&#xA;');
-    #13: wrtStr('&#xD;');
+    #9: Sender.wrtStr('&#x9;');
+    #10: Sender.wrtStr('&#xA;');
+    #13: Sender.wrtStr('&#xD;');
   else
-    wrtChr(c);
+    Sender.wrtChr(s[idx]);
   end;
 end;
 
-procedure TXMLWriter.TextnodeSpecialCharCallback(c: WideChar);
+procedure TextnodeSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
 begin
-  case c of
-    '<': wrtStr(ltStr);
-    '>': wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
-    '&': wrtStr(AmpStr);
+  case s[idx] of
+    '<': Sender.wrtStr(ltStr);
+    '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
+    '&': Sender.wrtStr(AmpStr);
   else
-    wrtChr(c);
+    Sender.wrtChr(s[idx]);
   end;
 end;
 
@@ -362,6 +389,155 @@ begin
   end;
 end;
 
+procedure TXMLWriter.WriteNSDef(B: TBinding);
+begin
+  wrtChars(' xmlns', 6);
+  if B.Prefix^.Key <> '' then
+  begin
+    wrtChr(':');
+    wrtStr(B.Prefix^.Key);
+  end;
+  wrtChars('="', 2);
+  ConvWrite(B.uri, AttrSpecialChars, @AttrSpecialCharCallback);
+  wrtChr('"');
+end;
+
+// clone of system.FPC_WIDESTR_COMPARE which cannot be called directly
+function Compare(const s1, s2: DOMString): integer;
+var
+  maxi, temp: integer;
+begin
+  Result := 0;
+  if pointer(S1) = pointer(S2) then
+    exit;
+  maxi := Length(S1);
+  temp := Length(S2);
+  if maxi > temp then
+    maxi := temp;
+  Result := CompareWord(S1[1], S2[1], maxi);
+  if Result = 0 then
+    Result := Length(S1)-Length(S2);
+end;
+
+function SortNSDefs(Item1, Item2: Pointer): Integer;
+begin
+  Result := Compare(TBinding(Item1).Prefix^.Key, TBinding(Item2).Prefix^.Key);
+end;
+
+function SortAtts(Item1, Item2: Pointer): Integer;
+var
+  p1: PAttrFixup absolute Item1;
+  p2: PAttrFixup absolute Item2;
+  s1, s2: DOMString;
+begin
+  Result := Compare(p1^.Attr.namespaceURI, p2^.Attr.namespaceURI);
+  if Result = 0 then
+  begin
+    // TODO: Must fix the parser so it doesn't produce Level 1 attributes
+    if nfLevel2 in p1^.Attr.Flags then
+      s1 := p1^.Attr.localName
+    else
+      s1 := p1^.Attr.nodeName;
+    if nfLevel2 in p2^.Attr.Flags then
+      s2 := p2^.Attr.localName
+    else
+      s2 := p2^.Attr.nodeName;
+    Result := Compare(s1, s2);
+  end;
+end;
+
+procedure TXMLWriter.NamespaceFixup(Element: TDOMElement);
+var
+  B: TBinding;
+  i, j: Integer;
+  node: TDOMNode;
+  s: DOMString;
+  action: TAttributeAction;
+  p: PAttrFixup;
+begin
+  FScratch.Count := 0;
+  FNSDefs.Count := 0;
+  if Element.hasAttributes then
+  begin
+    j := 0;
+    for i := 0 to Element.Attributes.Length-1 do
+    begin
+      node := Element.Attributes[i];
+      if TDOMNode_NS(node).NSI.NSIndex = 2 then
+      begin
+        if TDOMNode_NS(node).NSI.PrefixLen = 0 then
+          s := ''
+        else
+          s := node.localName;
+        FNSHelper.DefineBinding(s, node.nodeValue, B);
+        if Assigned(B) then  // drop redundant namespace declarations
+          FNSDefs.Add(B);
+      end
+      else if TDOMAttr(node).Specified then
+      begin
+        // obtain a TAttrFixup record (allocate if needed)
+        if j >= FAttrFixups.Count then
+        begin
+          New(p);
+          FAttrFixups.Add(p);
+        end
+        else
+          p := PAttrFixup(FAttrFixups.List^[j]);
+        // add it to the working list
+        p^.Attr := node;
+        p^.Prefix := nil;
+        FScratch.Add(p);
+        Inc(j);
+      end;
+    end;
+  end;
+
+  FNSHelper.DefineBinding(Element.Prefix, Element.namespaceURI, B);
+  if Assigned(B) then
+    FNSDefs.Add(B);
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    node := PAttrFixup(FScratch.List^[i])^.Attr;
+    action := FNSHelper.CheckAttribute(node.Prefix, node.namespaceURI, B);
+    if action = aaBoth then
+      FNSDefs.Add(B);
+
+    if action in [aaPrefix, aaBoth] then
+      PAttrFixup(FScratch.List^[i])^.Prefix := B.Prefix;
+  end;
+
+  if FCanonical then
+  begin
+    FNSDefs.Sort(@SortNSDefs);
+    FScratch.Sort(@SortAtts);
+  end;
+
+  // now, at last, dump all this stuff.
+  for i := 0 to FNSDefs.Count-1 do
+    WriteNSDef(TBinding(FNSDefs.List^[I]));
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    wrtChr(' ');
+    with PAttrFixup(FScratch.List^[I])^ do
+    begin
+      if Assigned(Prefix) then
+      begin
+        wrtStr(Prefix^.Key);
+        wrtChr(':');
+        wrtStr(Attr.localName);
+      end
+      else
+        wrtStr(Attr.nodeName);
+
+      wrtChars('="', 2);
+      // TODO: not correct w.r.t. entities
+      ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
+      wrtChr('"');
+    end;
+  end;
+end;
 
 procedure TXMLWriter.VisitElement(node: TDOMNode);
 var
@@ -371,10 +547,13 @@ var
 begin
   if not FInsideTextNode then
     wrtIndent;
+  FNSHelper.StartElement;
   wrtChr('<');
   wrtStr(TDOMElement(node).TagName);
-  // FIX: Accessing Attributes was causing them to be created for every element :(
-  if node.HasAttributes then
+
+  if nfLevel2 in node.Flags then
+    NamespaceFixup(TDOMElement(node))
+  else if node.HasAttributes then
     for i := 0 to node.Attributes.Length - 1 do
     begin
       child := node.Attributes.Item[i];
@@ -402,20 +581,26 @@ begin
     wrtStr(TDOMElement(Node).TagName);
     wrtChr('>');
   end;
+  FNSHelper.EndElement;
 end;
 
 procedure TXMLWriter.VisitText(node: TDOMNode);
 begin
-  ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback);
+  ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, @TextnodeSpecialCharCallback);
 end;
 
 procedure TXMLWriter.VisitCDATA(node: TDOMNode);
 begin
   if not FInsideTextNode then
     wrtIndent;
-  wrtChars('<![CDATA[', 9);
-  wrtStr(TDOMCharacterData(node).Data);
-  wrtChars(']]>', 3);
+  if FCanonical then
+    ConvWrite(TDOMCharacterData(node).Data, TextSpecialChars, @TextnodeSpecialCharCallback)
+  else
+  begin
+    wrtChars('<![CDATA[', 9);
+    wrtStr(TDOMCharacterData(node).Data);
+    wrtChars(']]>', 3);
+  end;
 end;
 
 procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
@@ -430,8 +615,11 @@ begin
   if not FInsideTextNode then wrtIndent;
   wrtStr('<?');
   wrtStr(TDOMProcessingInstruction(node).Target);
-  wrtChr(' ');
-  wrtStr(TDOMProcessingInstruction(node).Data);
+  if TDOMProcessingInstruction(node).Data <> '' then
+  begin
+    wrtChr(' ');
+    wrtStr(TDOMProcessingInstruction(node).Data);
+  end;
   wrtStr('?>');
 end;
 
@@ -500,7 +688,7 @@ begin
       ENTITY_REFERENCE_NODE:
         VisitEntityRef(Child);
       TEXT_NODE:
-        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
+        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
     end;
     Child := Child.NextSibling;
   end;

packages/fcl-xml/src/xpath.pp

@@ -34,8 +34,7 @@ resourcestring
   SVarNoConversion = 'Conversion from %s to %s not possible';
 
   { Scanner errors }
-  SScannerQuotStringIsOpen = 'Ending ''"'' for string not found';
-  SScannerAposStringIsOpen = 'Ending "''" for string not found';
+  SScannerUnclosedString = 'String literal was not closed';
   SScannerInvalidChar = 'Invalid character';
   SScannerMalformedQName = 'Expected "*" or local part after colon';
   SScannerExpectedVarName = 'Expected variable name after "$"';
@@ -252,6 +251,7 @@ type
     Axis: TAxis;
     NodeTestType: TNodeTestType;
     NodeTestString: DOMString;
+    NSTestString: DOMString;
     Predicates: TXPathNodeArray;
     constructor Create(aAxis: TAxis; aTest: TNodeTestType);
     destructor Destroy; override;
@@ -345,6 +345,8 @@ type
   end;
 
 
+  TXPathNSResolver = TDOMNode {!!! experimental};
+
 { XPath lexical scanner }
 
   TXPathScanner = class
@@ -355,6 +357,7 @@ type
     FTokenStart: DOMPChar;
     FTokenLength: Integer;
     FPrefixLength: Integer;
+    FResolver: TXPathNSResolver;
     procedure Error(const Msg: String);
     procedure ParsePredicates(var Dest: TXPathNodeArray);
     procedure ParseStep(Dest: TStep);          // [4]
@@ -471,8 +474,9 @@ type
   public
     { CompleteExpresion specifies wether the parser should check for gargabe
       after the recognised part. True => Throw exception if there is garbage }
-    constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean);
-    destructor destroy;override;
+    constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean;
+      AResolver: TXPathNSResolver = nil);
+    destructor Destroy; override;
     function Evaluate(AContextNode: TDOMNode): TXPathVariable;
     function Evaluate(AContextNode: TDOMNode;
       AEnvironment: TXPathEnvironment): TXPathVariable;
@@ -480,7 +484,7 @@ type
 
 
 function EvaluateXPathExpression(const AExpressionString: DOMString;
-  AContextNode: TDOMNode): TXPathVariable;
+  AContextNode: TDOMNode; AResolver: TXPathNSResolver = nil): TXPathVariable;
 
 
 // ===================================================================
@@ -524,7 +528,7 @@ var
 begin
   Val(s, Result, Code);
 {$push}
-{$r-}
+{$r-,q-}
   if Code <> 0 then
     Result := NaN;
 {$pop}
@@ -762,7 +766,7 @@ begin
           NumberResult := Op1 / Op2;
         opMod: if IsNan(Op1) or IsNan(Op2) then
 {$push}
-{$r-}
+{$r-,q-}
           NumberResult := NaN
 {$pop}
         else
@@ -1096,16 +1100,24 @@ var
           (Node.NodeType <> ELEMENT_NODE) then
           exit;
       ntName:
-        if Node.NodeName <> NodeTestString then
+        if NSTestString <> '' then
+        begin
+          if Node.namespaceURI <> NSTestString then
+            exit;
+          if (NodeTestString <> '') and (Node.localName <> NodeTestString) then
+            exit;
+        end
+        else if Node.NodeName <> NodeTestString then
           exit;
       ntTextNode:
-        if not Node.InheritsFrom(TDOMCharacterData) then
+        if not Node.InheritsFrom(TDOMText) then
           exit;
       ntCommentNode:
         if Node.NodeType <> COMMENT_NODE then
           exit;
       ntPINode:
-        if Node.NodeType <> PROCESSING_INSTRUCTION_NODE then
+        if (Node.NodeType <> PROCESSING_INSTRUCTION_NODE) or
+         ((NodeTestString <> '') and (Node.nodeName <> NodeTestString)) then
           exit;
     end;
     if ResultNodes.IndexOf(Node) < 0 then
@@ -1674,6 +1686,8 @@ function TXPathScanner.GetToken: TXPathToken;
     Result := tkNumber;
   end;
 
+var
+  Delim: WideChar;
 begin
   // Skip whitespace
   while (FCurData[0] < #255) and (char(ord(FCurData[0])) in [#9, #10, #13, ' ']) do
@@ -1681,6 +1695,7 @@ begin
 
   FTokenStart := FCurData;
   FTokenLength := 0;
+  Result := tkInvalid;
 
   case FCurData[0] of
     #0:
@@ -1690,21 +1705,19 @@ begin
       begin
         Inc(FCurData);
         Result := tkNotEqual;
-      end
-      else
-        Error(SScannerInvalidChar);
-    '"':
+      end;
+    '"', '''':
       begin
-        FTokenLength := 0;
+        Delim := FCurData^;
         Inc(FCurData);
         FTokenStart := FCurData;
-        while FCurData[0] <> '"' do
+        while FCurData[0] <> Delim do
         begin
           if FCurData[0] = #0 then
-            Error(SScannerQuotStringIsOpen);
+            Error(SScannerUnclosedString);
           Inc(FCurData);
-          Inc(FTokenLength);
         end;
+        FTokenLength := FCurData-FTokenStart;
         Result := tkString;
       end;
     '$':
@@ -1717,20 +1730,6 @@ begin
           Error(SScannerExpectedVarName);
         Exit;
       end;
-    '''':
-      begin
-        FTokenLength := 0;
-        Inc(FCurData);
-        FTokenStart := FCurData;
-        while FCurData[0] <> '''' do
-        begin
-          if FCurData[0] = #0 then
-            Error(SScannerAposStringIsOpen);
-          Inc(FCurData);
-          Inc(FTokenLength);
-        end;
-        Result := tkString;
-      end;
     '(':
       Result := tkLeftBracket;
     ')':
@@ -1766,8 +1765,7 @@ begin
       begin
         Inc(FCurData);
         Result := tkColonColon;
-      end else
-        Error(SScannerInvalidChar);  // single colons are handled as part of identifier
+      end;
     '<':
       if FCurData[1] = '=' then
       begin
@@ -1809,13 +1807,13 @@ begin
       end
       else
         Error(SScannerMalformedQName);
-    end
-    else
-      Error(SScannerInvalidChar);
+    end;
   end;
 
+  if Result = tkInvalid then
+    Error(SScannerInvalidChar);
   // We have processed at least one character now; eat it:
-  if Result <> tkEndOfStream then
+  if Result > tkEndOfStream then
     Inc(FCurData);
 end;
 
@@ -1923,7 +1921,12 @@ begin
     else if CurToken = tkNSNameTest then // [37] NameTest, second case
     begin
       NextToken;
-      // TODO: resolve the prefix and set Dest properties
+      if Assigned(FResolver) then
+        Dest.NSTestString := FResolver.lookupNamespaceURI(CurTokenString);
+      if Dest.NSTestString = '' then
+        // !! localization disrupted by DOM exception specifics
+        raise EDOMNamespace.Create('TXPathScanner.ParseStep');
+      Dest.NodeTestType := ntName;
     end
     else if CurToken = tkIdentifier then
     begin
@@ -1945,7 +1948,6 @@ begin
           NextToken;   { skip '('; we know it's there }
           if NextToken = tkString then
           begin
-            // TODO: Handle processing-instruction('name') constructs
             Dest.NodeTestString := CurTokenString;
             NextToken;
           end;
@@ -1964,14 +1966,17 @@ begin
       end
       else  // [37] NameTest, third case
       begin
-        // !!!: Doesn't support namespaces yet
-        // (this will have to wait until the DOM unit supports them)
         Dest.NodeTestType := ntName;
-        Dest.NodeTestString := CurTokenString;
         if FPrefixLength > 0 then
         begin
-          // TODO: resolve the prefix and set Dest properties
-        end;
+          if Assigned(FResolver) then
+            Dest.NSTestString := FResolver.lookupNamespaceURI(Copy(CurTokenString, 1, FPrefixLength));
+          if Dest.NSTestString = '' then
+            raise EDOMNamespace.Create('TXPathScanner.ParseStep');
+          Dest.NodeTestString := Copy(CurTokenString, FPrefixLength+2, MaxInt);
+        end
+        else
+          Dest.NodeTestString := CurTokenString;
         NextToken;
       end;
     end
@@ -2472,11 +2477,12 @@ var
   begin
     Head := 1;
     L := Length(s);
-    while (Head <= L) and IsXmlWhiteSpace(s[Head]) do
-      Inc(Head);
 
     while Head <= L do
     begin
+      while (Head <= L) and IsXmlWhiteSpace(s[Head]) do
+        Inc(Head);
+
       Tail := Head;
       while (Tail <= L) and not IsXmlWhiteSpace(s[Tail]) do
         Inc(Tail);
@@ -2486,8 +2492,6 @@ var
         ns.Add(Element);
 
       Head := Tail;
-      while IsXmlWhiteSpace(s[Head]) do
-        Inc(Head);
     end;
   end;
 
@@ -2563,17 +2567,27 @@ end;
 
 function TXPathEnvironment.xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
 var
+  n: TDOMNode;
   NodeSet: TNodeSet;
+  s: DOMString;
 begin
-// TODO: arg is optional, omission case must be handled
-  if Args.Count <> 1 then
+  if Args.Count > 1 then
     EvaluationError(SEvalInvalidArgCount);
-  NodeSet := TXPathVariable(Args[0]).AsNodeSet;
-  if NodeSet.Count = 0 then
-    Result := TXPathStringVariable.Create('')
+  n := nil;
+  if Args.Count = 0 then
+    n := Context.ContextNode
   else
-    // !!!: Probably not really correct regarding namespaces...
-    Result := TXPathStringVariable.Create(TDOMNode(NodeSet[0]).NodeName);
+  begin
+    NodeSet := TXPathVariable(Args[0]).AsNodeSet;
+    if NodeSet.Count > 0 then
+      n := TDOMNode(NodeSet[0]);
+  end;
+  // TODO: probably this isn't correct. XPath name() isn't the same as DOM nodeName.
+  if Assigned(n) then
+    s := n.nodeName
+  else
+    s := '';
+  Result := TXPathStringVariable.Create(s);
 end;
 
 function TXPathEnvironment.xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
@@ -2686,9 +2700,10 @@ begin
       n2 := floor(0.5 + e2);
   end;
   i := Max(n1, 1);
-  n2 := n2 + n1 - i;
   if empty then
-    n2 := -1;
+    n2 := -1
+  else if n2 < MaxInt then
+    n2 := n2 + (n1 - i);
   Result := TXPathStringVariable.Create(Copy(s, i, n2));
 end;
 
@@ -2853,9 +2868,10 @@ end;
 { TXPathExpression }
 
 constructor TXPathExpression.Create(AScanner: TXPathScanner;
-  CompleteExpression: Boolean);
+  CompleteExpression: Boolean; AResolver: TXPathNSResolver);
 begin
   inherited Create;
+  AScanner.FResolver := AResolver;
   FRootNode := AScanner.ParseOrExpr;
   if CompleteExpression and (AScanner.CurToken <> tkEndOfStream) then
     EvaluationError(SParserGarbageAfterExpression);
@@ -2901,14 +2917,14 @@ begin
 end;
 
 function EvaluateXPathExpression(const AExpressionString: DOMString;
-  AContextNode: TDOMNode): TXPathVariable;
+  AContextNode: TDOMNode; AResolver: TXPathNSResolver): TXPathVariable;
 var
   Scanner: TXPathScanner;
   Expression: TXPathExpression;
 begin
   Scanner := TXPathScanner.Create(AExpressionString);
   try
-    Expression := TXPathExpression.Create(Scanner, True);
+    Expression := TXPathExpression.Create(Scanner, True, AResolver);
     try
       Result := Expression.Evaluate(AContextNode);
     finally

packages/fcl-xml/tests/api.xml

@@ -262,6 +262,7 @@
 <item id="isId"/>
 <item id="documentURI" type="prop"/>
 <!--
+<item id="baseURI"/>
 // assertNotEquals
 // assertLowerSeverity
 
@@ -273,9 +274,13 @@
 <item id="lookupNamespaceURI">
   <arg>prefix</arg>
 </item>
+<item id="lookupPrefix">
+  <arg>namespaceURI</arg>
+</item>
+<item id="isDefaultNamespace">
+  <arg>namespaceURI</arg>
+</item>  
 <!--
-<item id="lookupPrefix"/>
-<item id="isDefaultNamespace"/>
 <item id="adoptNode"/>
 <item id="renameNode"/>
 <item id="replaceWholeText"/>

packages/fcl-xml/tests/domunit.pp

@@ -323,7 +323,7 @@ begin
   src := TXMLInputSource.Create(data);
   try
     FParser.Parse(src, TXMLDocument(Doc));
-    GC(Doc);
+    GC(TObject(Doc));
   finally
     src.Free;
   end;

packages/fcl-xml/tests/extras.pp

@@ -18,7 +18,7 @@ unit extras;
 interface
 
 uses
-  SysUtils, Classes, DOM, xmlread, domunit, testregistry;
+  SysUtils, Classes, DOM, xmlread, xmlwrite, domunit, testregistry;
 
 implementation
 
@@ -29,6 +29,9 @@ type
     procedure attr_ownership02;
     procedure attr_ownership03;
     procedure attr_ownership04;
+    procedure nsFixup1;
+    procedure nsFixup2;
+    procedure nsFixup3;
   end;
 
 { TDOMTestExtra }
@@ -113,7 +116,117 @@ begin
   AssertEquals('ownerElement2', el, attr2.OwnerElement);
 end;
 
+const
+  nsURI1 = 'http://www.example.com/ns1';
+  nsURI2 = 'http://www.example.com/ns2';
 
+// verify the namespace fixup with two nested elements
+// (same localName, different nsURI, and no prefixes)
+procedure TDOMTestExtra.nsFixup1;
+var
+  domImpl: TDOMImplementation;
+  origDoc: TDOMDocument;
+  parsedDoc: TDOMDocument;
+  docElem: TDOMElement;
+  el: TDOMElement;
+  stream: TStringStream;
+  list: TDOMNodeList;
+begin
+  FParser.Options.Namespaces := True;
+  domImpl := GetImplementation;
+  origDoc := domImpl.createDocument(nsURI1, 'test', nil);
+  GC(origDoc);
+  docElem := origDoc.documentElement;
+  el := origDoc.CreateElementNS(nsURI2, 'test');
+  docElem.AppendChild(el);
+
+  stream := TStringStream.Create('');
+  GC(stream);
+  writeXML(origDoc, stream);
+  LoadStringData(parsedDoc, stream.DataString);
+
+  docElem := parsedDoc.documentElement;
+  assertEquals('docElemLocalName', 'test', docElem.localName);
+  assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
+
+  list := docElem.GetElementsByTagNameNS(nsURI2, '*');
+  assertEquals('ns2_elementCount', 1, list.Length);
+  el := TDOMElement(list[0]);
+  assertEquals('ns2_nodeName', 'test', el.nodeName);
+end;
+
+// verify the namespace fixup with two nested elements
+// (same localName, different nsURI, different prefixes)
+procedure TDOMTestExtra.nsFixup2;
+var
+  domImpl: TDOMImplementation;
+  origDoc: TDOMDocument;
+  parsedDoc: TDOMDocument;
+  docElem: TDOMElement;
+  el: TDOMElement;
+  stream: TStringStream;
+  list: TDOMNodeList;
+begin
+  FParser.Options.Namespaces := True;
+  domImpl := GetImplementation;
+  origDoc := domImpl.createDocument(nsURI1, 'a:test', nil);
+  GC(origDoc);
+  docElem := origDoc.documentElement;
+  el := origDoc.CreateElementNS(nsURI2, 'b:test');
+  docElem.AppendChild(el);
+
+  stream := TStringStream.Create('');
+  GC(stream);
+  writeXML(origDoc, stream);
+  LoadStringData(parsedDoc, stream.DataString);
+
+  docElem := parsedDoc.documentElement;
+  assertEquals('docElemLocalName', 'test', docElem.localName);
+  assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
+
+  list := docElem.GetElementsByTagNameNS(nsURI2, '*');
+  assertEquals('ns2_elementCount', 1, list.Length);
+  el := TDOMElement(list[0]);
+  assertEquals('ns2_nodeName', 'b:test', el.nodeName);
+end;
+
+// verify the namespace fixup with two nested elements and an attribute
+// attribute's prefix must change to that of document element
+procedure TDOMTestExtra.nsFixup3;
+var
+  domImpl: TDOMImplementation;
+  origDoc: TDOMDocument;
+  parsedDoc: TDOMDocument;
+  docElem: TDOMElement;
+  el: TDOMElement;
+  stream: TStringStream;
+  list: TDOMNodeList;
+  attr: TDOMAttr;
+begin
+  FParser.Options.Namespaces := True;
+  domImpl := GetImplementation;
+  origDoc := domImpl.createDocument(nsURI1, 'a:test', nil);
+  GC(origDoc);
+  docElem := origDoc.documentElement;
+  el := origDoc.CreateElementNS(nsURI2, 'b:test');
+  docElem.AppendChild(el);
+  el.SetAttributeNS(nsURI1, 'test:attr', 'test value');
+
+  stream := TStringStream.Create('');
+  GC(stream);
+  writeXML(origDoc, stream);
+  LoadStringData(parsedDoc, stream.DataString);
+
+  docElem := parsedDoc.documentElement;
+  assertEquals('docElemLocalName', 'test', docElem.localName);
+  assertEquals('docElemNS', nsURI1, docElem.namespaceURI);
+
+  list := docElem.GetElementsByTagNameNS(nsURI2, '*');
+  assertEquals('ns2_elementCount', 1, list.Length);
+  el := TDOMElement(list[0]);
+  attr := el.GetAttributeNodeNS(nsURI1, 'attr');
+  assertEquals('attr_nodeName', 'a:attr', attr.nodeName);
+end;
 
 
 initialization

packages/fcl-xml/tests/extras2.pp

@@ -88,10 +88,7 @@ var
   nodeValue: DOMString;
   length: Integer;
 begin
-// canonical form: PreserveWhitespace, Namespaces, NamespaceDeclarations = True;
-//                 Entities, CDSections = False;
-  FParser.Options.PreserveWhitespace := True;
-  FParser.Options.Namespaces := True;
+  FParser.Options.CanonicalForm := True;
   LoadStringData(doc, canonicform01);
   begin
     node := TDOMNode(doc).firstChild;
@@ -152,10 +149,7 @@ var
   nodeValue: DOMString;
   length: Integer;
 begin
-// canonical form: PreserveWhitespace, Namespaces, NamespaceDeclarations = True;
-//                 Entities, CDSections = False;
-  FParser.Options.PreserveWhitespace := True;
-  FParser.Options.Namespaces := True;
+  FParser.Options.CanonicalForm := True;
   FParser.Options.IgnoreComments := True;
   LoadStringData(doc, canonicform01);
   begin
@@ -198,8 +192,7 @@ var
   divEl: TDOMElement;
   node: TDOMNode;
 begin
-  FParser.Options.PreserveWhitespace := True;
-  FParser.Options.Namespaces := True;
+  FParser.Options.CanonicalForm := True;
   LoadStringData(doc, canonicform03);
 
   divList := doc.getElementsByTagName('div');
@@ -220,8 +213,7 @@ var
   attrSpecified: Boolean;
   attrValue: DOMString;
 begin
-  FParser.Options.PreserveWhitespace := True;
-  FParser.Options.Namespaces := True;
+  FParser.Options.CanonicalForm := True;
   LoadStringData(doc, canonicform03);
 
   elemList := doc.getElementsByTagName('acronym');
@@ -252,6 +244,7 @@ begin
   FParser.Options.Namespaces := True;
   domImpl := GetImplementation;
   origDoc := domImpl.createDocument(namespaceURI, 'test', nil);
+  GC(origDoc);
   docElem := origDoc.documentElement;
   docElem.setAttributeNS(namespaceURI, 'attr', 'test value');
 
@@ -288,6 +281,7 @@ begin
   FParser.Options.Namespaces := True;
   domImpl := GetImplementation;
   origDoc := domImpl.createDocument(namespaceURI, 'test', nil);
+  GC(origDoc);
   docElem := origDoc.documentElement;
   docElem.setAttributeNS(namespaceURI, 'test:attr', 'test value');
 

packages/fcl-xml/tests/xmlts.pp

@@ -168,7 +168,7 @@ begin
   try
     for I := 0 to tables.Count-1 do
     begin
-      el := TDOMElement(tables.Item[I]);
+      el := TDOMElement(tables[I]);
       id := el['id'];
       if id = 'valid' then
         table_valid := el
@@ -208,7 +208,7 @@ begin
   Index := 0;
 
   repeat
-    Child := Children.Item[Index];
+    Child := Children[Index];
     if Child = nil then Break;
     Inc(index);
 
@@ -314,7 +314,7 @@ begin
   writeln('Testing, validation = ', FValidating);
   try
     for I := 0 to Cases.Count-1 do
-      RunTest(Cases.Item[I] as TDOMElement);
+      RunTest(Cases[I] as TDOMElement);
     I := Cases.Count;
   finally
     Cases.Free;
@@ -349,6 +349,7 @@ var
   Positive: Boolean;
   outURI: UTF8string;
   FailMsg: string;
+  ExceptionClass: TClass;
   docNode, refNode: TDOMNode;
   docMap, refMap: TDOMNamedNodeMap;
   docN, refN: TDOMNotation;
@@ -407,6 +408,7 @@ begin
       on E: Exception do
         if E.ClassType <> EAbort then
         begin
+          ExceptionClass := E.ClassType;
           FailMsg := E.Message;
           FValError := '';
         end;
@@ -435,7 +437,7 @@ begin
         if FailMsg <> '' then  // Fatal error
         begin
           { outside not-wf category it is a test failure }
-          if table <> table_not_wf then
+          if (table <> table_not_wf) or (ExceptionClass <> EXMLReadError) then
           begin
             Inc(FFailCount);
             Diagnose(Element, table, dcFail, FailMsg);

packages/fcl-xml/tests/xpathts.pp

@@ -33,6 +33,16 @@ type
     rtBool:   (b: Boolean);
   end;
 
+  TTestRec3 = record
+    data: string;                // UTF-8 encoded
+    re: string;
+    expr: DOMString;
+  case rt: TResultType of
+    rtString, rtNodeStr: (s: DOMPChar);   // cannot use DOMString here
+    rtNumber: (n: Extended);
+    rtBool:   (b: Boolean);
+  end;
+
 {$warnings off}
 const
   BaseTests: array[0..4] of TTestRec = (
@@ -542,7 +552,7 @@ const
   '<b ns1:attrib2="test"/>'#10+
   '</doc>';
 
-  StringTests: array[0..84] of TTestRec = (             // numbers refer to xalan/string/stringXX
+  StringTests: array[0..74] of TTestRec = (             // numbers refer to xalan/string/stringXX
     (expr: 'string(0)';       rt: rtString; s: '0'),
     (expr: 'string(5)';       rt: rtString; s: '5'),    // #38/39
     (expr: 'string(0.5)';     rt: rtString; s: '0.5'),
@@ -573,8 +583,6 @@ const
     (expr: 'starts-with("", "")';            rt: rtBool; b: True),     // #49
     (expr: 'starts-with(true(), "tr")';      rt: rtBool; b: True),     // #50
 
-
-
     (expr: 'contains("tititototata","titi")'; rt: rtBool; b: True),
     (expr: 'contains("tititototata","toto")'; rt: rtBool; b: True),
     (expr: 'contains("tititototata","tata")'; rt: rtBool; b: True),
@@ -625,18 +633,6 @@ const
     (expr: 'translate("--aaa--","abc-","ABC")'; rt: rtString; s: 'AAA'),
     (expr: 'translate("ddaaadddd","abcd","ABCxy")'; rt: rtString; s: 'xxAAAxxxx'),   // #96
 
-    (data: str30; expr: 'namespace-uri(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''), // #30
-    (data: str30; expr: 'namespace-uri(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'http://xsl.lotus.com/ns1'), // #31
-    (data: str30; expr: 'name(*)'; rt: rtString; s: 'ns1:a'),       // #32
-    (data: str30; expr: 'name(baz1:a)'; rt: rtString; s: 'ns1:a'),  // #33
-    (data: str30; expr: 'name(baz2:b)'; rt: rtString; s: 'b'),      // #34
-    (data: str30; expr: 'name(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''),            // #35
-    (data: str30; expr: 'name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'ns1:attrib2'), // #36
-
-    (data: str30; expr: 'local-name(baz2:b)'; rt: rtString; s: 'b'), // namespace07
-    (data: str30; expr: 'local-name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'attrib2'), // namespace09
-    (data: str30; expr: 'local-name()'; rt: rtString; s: 'doc'),      // namespace26
-    
     // tests for number->string conversions at boundary conditions
     (expr: 'string(123456789012345678)';     rt: rtString; s: '123456789012345680'),    // #132.1
     (expr: 'string(-123456789012345678)';    rt: rtString; s: '-123456789012345680'),   // #132.2
@@ -650,7 +646,23 @@ const
     (expr: 'string(-.0000000000000000000000000000000000000000123456789)'; rt: rtString; // #135.2
       s: '-0.0000000000000000000000000000000000000000123456789')
   );
-  
+
+  res1 = '<foo xmlns:baz1="http://xsl.lotus.com/ns1" xmlns:baz2="http://xsl.lotus.com/ns2"/>';
+
+  nameTests: array[0..9] of TTestRec3 = (
+    (data: str30; re: res1; expr: 'namespace-uri(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''), // #30
+    (data: str30; re: res1; expr: 'namespace-uri(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'http://xsl.lotus.com/ns1'), // #31
+    (data: str30; re: res1; expr: 'name(*)'; rt: rtString; s: 'ns1:a'),       // #32
+    (data: str30; re: res1; expr: 'name(baz1:a)'; rt: rtString; s: 'ns1:a'),  // #33
+    (data: str30; re: res1; expr: 'name(baz2:b)'; rt: rtString; s: 'b'),      // #34
+    (data: str30; re: res1; expr: 'name(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''),            // #35
+    (data: str30; re: res1; expr: 'name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'ns1:attrib2'), // #36
+
+    (data: str30; re: res1; expr: 'local-name(baz2:b)'; rt: rtString; s: 'b'), // namespace07
+    (data: str30; re: res1; expr: 'local-name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'attrib2'), // namespace09
+    (data: str30; re: res1; expr: 'local-name()'; rt: rtString; s: 'doc')      // namespace26
+  );
+
   ax114='<doc>'+
   '<foo att1="c">'+
   '  <foo att1="b">'+
@@ -814,8 +826,47 @@ begin
   end;
 end;
 
+procedure DoSuite3(const tests: array of TTestRec3);
+var
+  i: Integer;
+  doc: TXMLDocument;
+  rslt: TXPathVariable;
+  nsdoc: TXMLDocument;
+  temp: TTestRec;
+begin
+  for i := 0 to High(tests) do
+  begin
+    doc := ParseString(tests[i].data);
+    try
+      nsdoc := ParseString(tests[i].re);
+      try
+        try
+          rslt := EvaluateXPathExpression(tests[i].expr, doc.DocumentElement, nsdoc.DocumentElement);
+          try
+            temp.data := tests[i].data;
+            temp.expr := tests[i].expr;
+            temp.rt := tests[i].rt;
+            temp.n := tests[i].n;
+            CheckResult(temp, rslt);
+          finally
+            rslt.Free;
+          end;
+        except
+          writeln;
+          writeln('Failed: ', tests[i].expr);
+          SysUtils.ShowException(ExceptObject, ExceptAddr);
+          Inc(FailCount);
+        end;
+      finally
+        nsdoc.Free;
+      end;
+    finally
+      doc.Free;
+    end;
+  end;
+end;
+
 begin
-  DecimalSeparator := '.';
   DoSuite(BaseTests);
   DoSuite(CompareTests);
   DoSuite(NodesetCompareTests);  
@@ -825,6 +876,8 @@ begin
   DoSuite(StringTests);
   DoSuite(AxesTests);
 
+  DoSuite3(nameTests);
+
   writeln;
   writeln('Total failed tests: ', FailCount);
 end.