* Patch from Sergei Gorelkin to improve DOM compliance:

dom.pp:
* Document.OwnerDocument returns nil.
* Document.TextContent returns empty string and setting it does nothing.
* Fixed EntityReference, it now gets its children upon creation and is
  correctly imported between documents.
+ Node.IsSupported()
* DOM feature name comparison is done case-insensitive.
* Reworked Node.AppendChild/Node.InsertBefore. Duplicate functionality
  removed. Resolves remaining issues with hierarchy/ownership checks
  (except for Document nodes which is a different story altogether).
  The same code is now executed for nodes attached to a Fragment as
  well as for regular nodes.
+ Text.SplitText checks for valid ParentNode.

xmlread.pp:
+ Implemented TDOMParser.ParseWithContext (except the case of replacing
  the whole document)
* Fixed AV when calling ParseXXX methods with input source that could
  not be resolved.
* Completely ignore comments in external DTD subset, it fixes a couple
  of DOM tests and has no effect on XML testsuite.

git-svn-id: trunk@11217 -

packages/fcl-xml/src/dom.pp

@@ -211,6 +211,7 @@ type
     function GetNamespaceURI: DOMString; virtual;
     function GetPrefix: DOMString; virtual;
     procedure SetPrefix(const Value: DOMString); virtual;
+    function GetOwnerDocument: TDOMDocument; virtual;
   public
     constructor Create(AOwner: TDOMDocument);
     destructor Destroy; override;
@@ -228,21 +229,18 @@ type
     property PreviousSibling: TDOMNode read FPreviousSibling;
     property NextSibling: TDOMNode read FNextSibling;
     property Attributes: TDOMNamedNodeMap read GetAttributes;
-    // DOM 2: is now nil for documents and unused DocTypes
-    property OwnerDocument: TDOMDocument read FOwnerDocument;
+    property OwnerDocument: TDOMDocument read GetOwnerDocument;
 
     function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
     function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
     function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
     function RemoveChild(OldChild: TDOMNode): TDOMNode;
-    function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
+    function AppendChild(NewChild: TDOMNode): TDOMNode;
     function HasChildNodes: Boolean; virtual;
     function CloneNode(deep: Boolean): TDOMNode; overload;
 
     // DOM level 2
-    (*
-    function Supports(const Feature, Version: DOMString): Boolean;
-    *)
+    function IsSupported(const Feature, Version: DOMString): Boolean;
     function HasAttributes: Boolean; virtual;
     procedure Normalize; virtual;
 
@@ -279,7 +277,6 @@ type
     function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
     function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
     function DetachChild(OldChild: TDOMNode): TDOMNode; override;
-    function AppendChild(NewChild: TDOMNode): TDOMNode; override;
     function HasChildNodes: Boolean; override;
     function FindNode(const ANodeName: DOMString): TDOMNode; override;
   end;
@@ -302,6 +299,7 @@ type
     destructor Destroy; override;
     property Item[index: LongWord]: TDOMNode read GetItem; default;
     property Count: LongWord read GetCount;
+    property Length: LongWord read GetCount;
   end;
 
   { an extension to DOM interface, used to build recursive lists of elements }
@@ -416,6 +414,9 @@ type
     function GetDocType: TDOMDocumentType;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
+    function GetTextContent: DOMString; override;
+    function GetOwnerDocument: TDOMDocument; override;
+    procedure SetTextContent(const value: DOMString); override;
     function IndexOfNS(const nsURI: DOMString): Integer;
     function FindID(const aID: DOMString; out Index: LongWord): Boolean;
     procedure ClearIDList;
@@ -877,8 +878,7 @@ end;
 
 function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
 begin
-  raise EDOMHierarchyRequest.Create('Node.AppendChild');
-  Result:=nil;
+  Result := InsertBefore(NewChild, nil);
 end;
 
 function TDOMNode.HasChildNodes: Boolean;
@@ -909,6 +909,11 @@ begin
   Result := FOwnerDocument.FRevision;
 end;
 
+function TDOMNode.IsSupported(const Feature, Version: DOMString): Boolean;
+begin
+  Result := FOwnerDocument.Impl.HasFeature(Feature, Version);
+end;
+
 function TDOMNode.HasAttributes: Boolean;
 begin
   Result := False;
@@ -983,6 +988,11 @@ begin
   // do nothing, override for Elements and Attributes
 end;
 
+function TDOMNode.GetOwnerDocument: TDOMDocument;
+begin
+  Result := FOwnerDocument;
+end;
+
 function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
 var i: integer;
 begin
@@ -1063,20 +1073,19 @@ var
   NewChildType: Integer;
 begin
   Result := NewChild;
+  NewChildType := NewChild.NodeType;
 
-  if not Assigned(RefChild) then
+  if NewChild.FOwnerDocument <> FOwnerDocument then
   begin
-    AppendChild(NewChild);
-    exit;
+    if (NewChildType <> DOCUMENT_TYPE_NODE) or
+    (NewChild.FOwnerDocument <> nil) then
+      raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
   end;
 
-  if NewChild.FOwnerDocument <> FOwnerDocument then
-    raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
-
-  if RefChild.ParentNode <> Self then
+  if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
     raise EDOMNotFound.Create('NodeWC.InsertBefore');
 
-  NewChildType := NewChild.NodeType;
+  // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)  
   if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
   begin
     Tmp := Self;
@@ -1087,45 +1096,26 @@ begin
       Tmp := Tmp.ParentNode;
     end;
   end;
+  if NewChild = RefChild then    // inserting node before itself is a no-op
+    Exit;
 
   Inc(FOwnerDocument.FRevision); // invalidate nodelists
 
-  // DONE: Implemented InsertBefore for DocumentFragments (except ChildNodeTree)
   if NewChildType = DOCUMENT_FRAGMENT_NODE then
   begin
-    // Is fragment empty?
     Tmp := NewChild.FirstChild;
-    if not Assigned(Tmp) then
-      Exit;
-    // reparent nodes
-    while Assigned(Tmp) do
-    begin
-      Tmp.FParentNode := Self;
-      Tmp := Tmp.NextSibling;
-    end;
-
-    // won't get here if RefChild = nil...
-    if (RefChild = nil) or (RefChild.FPreviousSibling = nil) then
-    begin  // insert at the beginning  <- AppendChild ??? ->
-      // no, AppendChild will insert after RefChild and we need it before
-      if Assigned(FFirstChild) then
-        FFirstChild.FPreviousSibling := NewChild.LastChild;
-      NewChild.LastChild.FNextSibling := FirstChild;
-      if not Assigned(FLastChild) then
-        FLastChild := NewChild.LastChild;
-      FFirstChild := NewChild.FirstChild;
-    end
-    else  // insert to the middle
+    if Assigned(Tmp) then
     begin
-      NewChild.LastChild.FNextSibling := RefChild;
-      NewChild.FirstChild.FPreviousSibling := RefChild.FPreviousSibling;
-      RefChild.FPreviousSibling.FNextSibling := NewChild.FirstChild;
-      RefChild.FPreviousSibling := NewChild.LastChild;
+      while Assigned(Tmp) do
+      begin
+        if not (Tmp.NodeType in ValidChildren[NodeType]) then
+          raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
+        Tmp := Tmp.NextSibling;
+      end;
+    
+      while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
+        InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
     end;
-    // finally, detach nodes from the fragment
-    TDOMDocumentFragment(NewChild).FFirstChild := nil;
-    TDOMDocumentFragment(NewChild).FLastChild := nil;
-    // TODO: ChildNodeTree...
     Exit;
   end;
 
@@ -1136,15 +1126,27 @@ begin
     NewChild.FParentNode.DetachChild(NewChild);
 
   NewChild.FNextSibling := RefChild;
-  if RefChild = FFirstChild then
-    FFirstChild := NewChild
-  else
+  if RefChild = nil then  // append to the end
   begin
-    RefChild.FPreviousSibling.FNextSibling := NewChild;
-    NewChild.FPreviousSibling := RefChild.FPreviousSibling;
+    if Assigned(FFirstChild) then
+    begin
+      FLastChild.FNextSibling := NewChild;
+      NewChild.FPreviousSibling := FLastChild;
+    end else
+      FFirstChild := NewChild;
+    FLastChild := NewChild;
+  end
+  else   // insert before RefChild
+  begin
+    if RefChild = FFirstChild then
+      FFirstChild := NewChild
+    else
+    begin
+      RefChild.FPreviousSibling.FNextSibling := NewChild;
+      NewChild.FPreviousSibling := RefChild.FPreviousSibling;
+    end;
+    RefChild.FPreviousSibling := NewChild;
   end;
-
-  RefChild.FPreviousSibling := NewChild;
   NewChild.FParentNode := Self;
   AddToChildNodeTree(NewChild);
 end;
@@ -1185,76 +1187,6 @@ begin
   Result := OldChild;
 end;
 
-function TDOMNode_WithChildren.AppendChild(NewChild: TDOMNode): TDOMNode;
-var
-  Tmp: TDOMNode;
-  NewChildType: Integer;
-begin
-  if NewChild.FOwnerDocument <> FOwnerDocument then
-    raise EDOMWrongDocument.Create('NodeWC.AppendChild');
-
-  // Don't walk the tree if NewChild apriori cannot be our parent.
-  // This saves a lot of CPU cache misses.
-  NewChildType := NewChild.NodeType;
-  if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
-  begin
-    Tmp := Self;
-    while Assigned(Tmp) do
-    begin
-      if Tmp = NewChild then
-        raise EDOMHierarchyRequest.Create('NodeWC.AppendChild (cycle in tree)');
-      Tmp := Tmp.ParentNode;
-    end;
-  end;
-  Inc(FOwnerDocument.FRevision); // invalidate nodelists
-
-  // DONE: supported AppendChild for DocumentFragments (except ChildNodeTree)
-  if NewChildType = DOCUMENT_FRAGMENT_NODE then
-  begin
-    Tmp := NewChild.FirstChild;
-    // Is fragment empty?
-    if Assigned(Tmp) then
-    begin
-      // reparent nodes
-      while Assigned(Tmp) do
-      begin
-        Tmp.FParentNode := Self;
-        Tmp := Tmp.NextSibling;
-      end;
-
-      if Assigned(FLastChild) then
-        FLastChild.FNextSibling := NewChild.FirstChild;
-      NewChild.FirstChild.FPreviousSibling := LastChild;
-      if not Assigned(FFirstChild) then
-        FFirstChild := NewChild.FirstChild;
-      FLastChild := NewChild.LastChild;
-      // detach nodes from fragment
-      TDOMDocumentFragment(NewChild).FFirstChild := nil;
-      TDOMDocumentFragment(NewChild).FLastChild := nil;
-      // TODO: ChildNodeTree...
-    end;
-  end
-  else
-  begin
-    if not (NewChildType in ValidChildren[NodeType]) then
-      raise EDOMHierarchyRequest.Create('NodeWC.AppendChild');
-
-    if Assigned(NewChild.FParentNode) then
-      NewChild.FParentNode.DetachChild(NewChild);
-
-    if Assigned(FFirstChild) then
-    begin
-      FLastChild.FNextSibling := NewChild;
-      NewChild.FPreviousSibling := FLastChild;
-    end else
-      FFirstChild := NewChild;
-    FLastChild := NewChild;
-    NewChild.FParentNode := Self;
-    AddToChildNodeTree(NewChild);
-  end;
-  Result := NewChild;
-end;
-
 function TDOMNode_WithChildren.HasChildNodes: Boolean;
 begin
   Result := Assigned(FFirstChild);
@@ -1625,7 +1557,7 @@ end;
 
 function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
 begin
-  if (offset > Length) then
+  if offset > Length then
     raise EDOMIndexSize.Create('CharacterData.SubstringData');
   Result := Copy(FNodeValue, offset + 1, count);
 end;
@@ -1637,20 +1569,16 @@ end;
 
 procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
 begin
-  if (offset > Length) then
+  if offset > Length then
     raise EDOMIndexSize.Create('CharacterData.InsertData');
-  // TODO: use System.Insert?
-  FNodeValue := Copy(FNodeValue, 1, offset) + arg +
-    Copy(FNodeValue, offset + 1, Length);
+  Insert(arg, FNodeValue, offset+1);
 end;
 
 procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
 begin
-  if (offset > Length) then
+  if offset > Length then
     raise EDOMIndexSize.Create('CharacterData.DeleteData');
-  // TODO: use System.Delete?
-  FNodeValue := Copy(FNodeValue, 1, offset) +
-    Copy(FNodeValue, offset + count + 1, Length);
+  Delete(FNodeValue, offset+1, count);
 end;
 
 procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
@@ -1687,17 +1615,11 @@ end;
 
 function TDOMImplementation.HasFeature(const feature, version: DOMString):
   Boolean;
+var
+  s: string;
 begin
-  // very basic
-  if (feature = 'XML') then
-  begin
-    if (version = '') or (version = '1.0') then
-      Result := True
-    else
-      Result := False;
-  end
-  else
-    Result := False;
+  s := feature;   // force Ansi, features do not contain non-ASCII chars
+  Result := SameText(s, 'XML') and ((version = '') or (version = '1.0'));
 end;
 
 function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
@@ -1707,12 +1629,9 @@ begin
   Result := TDOMDocumentType.Create(nil);
   Result.FName := QualifiedName;
 
-  // cannot have PublicID without SystemID
-  if SystemID <> '' then
-  begin
-    Result.FPublicID := PublicID;
-    Result.FSystemID := SystemID;
-  end;
+  // DOM does not restrict PublicID without SystemID (unlike XML spec)
+  Result.FPublicID := PublicID;
+  Result.FSystemID := SystemID;
 end;
 
 function TDOMImplementation.CreateDocument(const NamespaceURI,
@@ -1845,6 +1764,21 @@ begin
   Result := '#document';
 end;
 
+function TDOMDocument.GetTextContent: DOMString;
+begin
+  Result := '';
+end;
+
+procedure TDOMDocument.SetTextContent(const value: DOMString);
+begin
+  // Document ignores setting TextContent
+end;
+
+function TDOMDocument.GetOwnerDocument: TDOMDocument;
+begin
+  Result := nil;
+end;
+
 function TDOMDocument.GetDocumentElement: TDOMElement;
 var
   node: TDOMNode;
@@ -2015,12 +1949,21 @@ end;
 
 function TXMLDocument.CreateEntityReference(const name: DOMString):
   TDOMEntityReference;
+var
+  dType: TDOMDocumentType;
+  ent: TDOMEntity;
 begin
   if not IsXmlName(name, FXML11) then
     raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
   Result := TDOMEntityReference.Create(Self);
   Result.FName := name;
-  // TODO: if entity is known, its child list must be cloned or so.
+  dType := DocType;
+  if Assigned(dType) then
+  begin
+    TDOMNode(ent) := dType.Entities.GetNamedItem(name);
+    if Assigned(ent) then
+      ent.CloneChildren(Result, Self);
+  end;
 end;
 
 procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
@@ -2311,7 +2254,8 @@ begin
   Result.FNodeValue := Copy(FNodeValue, offset + 1, Length);
   Result.FMayBeIgnorable := FMayBeIgnorable;
   FNodeValue := Copy(FNodeValue, 1, offset);
-  FParentNode.InsertBefore(Result, FNextSibling);
+  if Assigned(FParentNode) then
+    FParentNode.InsertBefore(Result, FNextSibling);
 end;
 
 
@@ -2442,7 +2386,9 @@ begin
   TDOMEntity(Result).FName := FName;
   TDOMEntity(Result).FSystemID := FSystemID;
   TDOMEntity(Result).FPublicID := FPublicID;
-  TDOMEntity(Result).FNotationName := FNotationName;  
+  TDOMEntity(Result).FNotationName := FNotationName;
+  if deep then
+    CloneChildren(Result, aCloneOwner);
 end;
 
 // -------------------------------------------------------
@@ -2462,8 +2408,6 @@ end;
 function TDOMEntityReference.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
 begin
   Result := ACloneOwner.CreateEntityReference(FName);
-  // TODO -cConformance: this is done in CreateEntityReference?
-  CloneChildren(Result, ACloneOwner);
 end;
 
 // -------------------------------------------------------

packages/fcl-xml/src/xmlread.pp

@@ -73,8 +73,12 @@ type
   end;
 
   // NOTE: DOM 3 LS ACTION_TYPE enumeration starts at 1
-  TXMLContextAction = (xaAppendAsChildren, xaReplaceChildren, xaInsertBefore,
-                       xaInsertAfter, xaReplace);
+  TXMLContextAction = (
+    xaAppendAsChildren = 1,
+    xaReplaceChildren,
+    xaInsertBefore,
+    xaInsertAfter,
+    xaReplace);
 
   TXMLErrorEvent = procedure(Error: EXMLReadError) of object;
 
@@ -395,6 +399,7 @@ type
     procedure ValidationError(const Msg: string; const args: array of const; LineOffs: Integer = -1);
     procedure DoAttrText(ch: PWideChar; Count: Integer);    
     procedure DTDReloadHook;
+    procedure ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
     // Some SAX-alike stuff (at a very early stage)
     procedure DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean=False);
     procedure DoComment(ch: PWideChar; Count: Integer);
@@ -433,6 +438,8 @@ type
     destructor Destroy; override;
   end;
 
+const
+  NullLocation: TLocation = (Line: 0; LinePos: 0);
 
 function Decode_UCS2(Src: TXMLDecodingSource): WideChar;
 begin
@@ -606,20 +613,8 @@ var
 begin
   with TXMLReader.Create(Self) do
   try
-    InputSrc := nil;
-    if Assigned(Src) then
-    begin
-      if Assigned(Src.FStream) then
-        InputSrc := TXMLStreamInputSource.Create(Src.FStream, False)
-      else if Src.FStringData <> '' then
-        InputSrc := TXMLStreamInputSource.Create(TStringStream.Create(Src.FStringData), True)
-      else if (Src.SystemID <> '') then
-        ResolveEntity(Src.SystemID, Src.PublicID, InputSrc);
-    end;
-    if Assigned(InputSrc) then
-      ProcessXML(InputSrc)
-    else
-      FatalError('No input source specified');
+    ConvertSource(Src, InputSrc);  // handles 'no-input-specified' case
+    ProcessXML(InputSrc)
   finally
     ADoc := TXMLDocument(doc);
     Free;
@@ -643,9 +638,46 @@ end;
 
 function TDOMParser.ParseWithContext(Src: TXMLInputSource;
   Context: TDOMNode; Action: TXMLContextAction): TDOMNode;
+var
+  InputSrc: TXMLCharSource;
+  Frag: TDOMDocumentFragment;
+  node: TDOMNode;
 begin
-  // TODO: implement
-  Result := nil;
+  if Action in [xaInsertBefore, xaInsertAfter, xaReplace] then
+    node := Context.ParentNode
+  else
+    node := Context;
+  // TODO: replacing document isn't yet supported  
+  if (Action = xaReplaceChildren) and (node.NodeType = DOCUMENT_NODE) then
+    raise EDOMNotSupported.Create('DOMParser.ParseWithContext');
+
+  if not (node.NodeType in [ELEMENT_NODE, DOCUMENT_FRAGMENT_NODE]) then
+    raise EDOMHierarchyRequest.Create('DOMParser.ParseWithContext');
+
+  with TXMLReader.Create(Self) do
+  try
+    ConvertSource(Src, InputSrc);    // handles 'no-input-specified' case
+    Frag := Context.OwnerDocument.CreateDocumentFragment;
+    try
+      ProcessFragment(InputSrc, Frag);
+      Result := Frag.FirstChild;
+      case Action of
+        xaAppendAsChildren: Context.AppendChild(Frag);
+
+        xaReplaceChildren: begin
+          Context.TextContent := '';     // removes children
+          Context.ReplaceChild(Frag, Context.FirstChild);
+        end;
+        xaInsertBefore: node.InsertBefore(Frag, Context);
+        xaInsertAfter:  node.InsertBefore(Frag, Context.NextSibling);
+        xaReplace:      node.ReplaceChild(Frag, Context);
+      end;
+    finally
+      Frag.Free;
+    end;
+  finally
+    Free;
+  end;
 end;
 
 // TODO: These classes still cannot be considered as the final solution...
@@ -822,7 +854,7 @@ begin
   FDecoder := @Decode_UTF8;
   FFixedUCS2 := '';
   if FCharBufEnd-FCharBuf > 1 then
-    begin
+  begin
     if (FCharBuf[0] = #$FE) and (FCharBuf[1] = #$FF) then
     begin
       FFixedUCS2 := 'UTF-16BE';
@@ -931,8 +963,37 @@ begin
   end;
 end;
 
+{ helper that closes handle upon destruction }
+type
+  THandleOwnerStream = class(THandleStream)
+  public
+    destructor Destroy; override;
+  end;
+
+destructor THandleOwnerStream.Destroy;
+begin
+  if Handle >= 0 then FileClose(Handle);
+  inherited Destroy;
+end;
+
 { TXMLReader }
 
+procedure TXMLReader.ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
+begin
+  SrcOut := nil;
+  if Assigned(SrcIn) then
+  begin
+    if Assigned(SrcIn.FStream) then
+      SrcOut := TXMLStreamInputSource.Create(SrcIn.FStream, False)
+    else if SrcIn.FStringData <> '' then
+      SrcOut := TXMLStreamInputSource.Create(TStringStream.Create(SrcIn.FStringData), True)
+    else if (SrcIn.SystemID <> '') then
+      ResolveEntity(SrcIn.SystemID, SrcIn.PublicID, SrcOut);
+  end;
+  if (SrcOut = nil) and (FSource = nil) then
+    DoErrorPos(esFatal, 'No input source specified', NullLocation);
+end;
+
 procedure TXMLReader.StoreLocation(out Loc: TLocation);
 begin
   Loc.Line := FSource.FLocation.Line;
@@ -944,32 +1005,34 @@ var
   AbsSysID: WideString;
   Filename: string;
   Stream: TStream;
+  fd: THandle;
 begin
-  Result := True;
-  if Assigned(FSource) then
-    Result := ResolveRelativeURI(FSource.SystemID, SystemID, AbsSysID)
+  Source := nil;
+  Result := False;
+  if not Assigned(FSource) then
+    AbsSysID := SystemID
   else
-    AbsSysID := SystemID;
-
-  if Result then
-  begin
-    Source := nil;
-    Result := False;
-    // TODO: alternative resolvers
-    if URIToFilename(AbsSysID, Filename) then
+    if not ResolveRelativeURI(FSource.SystemID, 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
+    ( so that internal classes need not be exported ).
+    External resolver will produce TXMLInputSource that should be converted.
+    External resolver must NOT be called for root entity.
+    External resolver can return nil, in which case we do the default }
+  if URIToFilename(AbsSysID, Filename) then
+  begin
+    fd := FileOpen(Filename, fmOpenRead + fmShareDenyWrite);
+    if fd <> THandle(-1) then
     begin
-      try
-        Stream := TFileStream.Create(Filename, fmOpenRead + fmShareDenyWrite);
-        Source := TXMLStreamInputSource.Create(Stream, True);
-        Source.SystemID := AbsSysID;
-        Source.PublicID := PublicID;
-        Result := True;
-      except
-        on E: Exception do
-          ValidationError('%s', [E.Message]);
-      end;
+      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);
 end;
 
 procedure TXMLReader.Initialize(ASource: TXMLCharSource);
@@ -1034,13 +1097,17 @@ procedure TXMLReader.DoErrorPos(Severity: TErrorSeverity; const descr: string; c
 var
   E: EXMLReadError;
 begin
-  E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, ErrPos.Line, ErrPos.LinePos, descr]);
+  if Assigned(FSource) then
+    E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, ErrPos.Line, ErrPos.LinePos, descr])
+  else
+    E := EXMLReadError.Create(descr);
   E.FSeverity := Severity;
   E.FErrorMessage := descr;
   E.FLine := ErrPos.Line;
   E.FLinePos := ErrPos.LinePos;
   CallErrorHandler(E);
   // No 'finally'! If user handler raises exception, control should not get here
+  // and the exception will be freed in CallErrorHandler (below)
   E.Free;
 end;
 
@@ -1175,7 +1242,8 @@ destructor TXMLReader.Destroy;
 begin
   FreeMem(FName.Buffer);
   FreeMem(FValue.Buffer);
-  while ContextPop do;     // clean input stack
+  if Assigned(FSource) then
+    while ContextPop do;     // clean input stack
   FSource.Free;
   FPEMap.Free;
   ClearRefs(FNotationRefs);
@@ -1206,7 +1274,7 @@ begin
     FatalError('Root element is missing');
 
   if FValidate and Assigned(FDocType) then
-      ValidateIdRefs;
+    ValidateIdRefs;
 end;
 
 procedure TXMLReader.ProcessFragment(ASource: TXMLCharSource; AOwner: TDOMNode);
@@ -1406,7 +1474,11 @@ begin
   begin
     Result := ResolveEntity(AEntity.SystemID, AEntity.PublicID, Src);
     if not Result then
+    begin
+      // TODO: a detailed message like SysErrorMessage(GetLastError) would be great here 
+      ValidationError('Unable to resolve external entity ''%s''', [AEntity.NodeName]);
       Exit;
+    end;
   end
   else
   begin
@@ -1450,7 +1522,7 @@ procedure TXMLReader.IncludeEntity(InAttr: Boolean);
 var
   AEntity: TDOMEntityEx;
   RefName: WideString;
-  Node, Child: TDOMNode;
+  Child: TDOMNode;
 begin
   AEntity := nil;
   SetString(RefName, FName.Buffer, FName.Length);
@@ -1495,17 +1567,17 @@ begin
       end;
     end;
   end;
-  Node := FCursor;
   if (not FExpandEntities) or (not AEntity.FResolved) then
   begin
-    Node := doc.CreateEntityReference(RefName);
-    FCursor.AppendChild(Node);
+    // This will clone Entity children
+    FCursor.AppendChild(doc.CreateEntityReference(RefName));
+    Exit;
   end;
 
   Child := AEntity.FirstChild;  // clone the entity node tree
   while Assigned(Child) do
   begin
-    Node.AppendChild(Child.CloneNode(True));
+    FCursor.AppendChild(Child.CloneNode(True));
     Child := Child.NextSibling;
   end;
 end;
@@ -1839,16 +1911,21 @@ begin
   end;
   ExpectChar('>');
 
-  if (FDocType.SystemID <> '') and ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
+  if (FDocType.SystemID <> '') then
   begin
-    ContextPush(Src);
-    try
-      Src.DTDSubsetType := dsExternal;
-      ParseMarkupDecl;
-    finally
-      Src.DTDSubsetType := dsNone;
-      ContextPop;
-    end;
+    if ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
+    begin
+      ContextPush(Src);
+      try
+        Src.DTDSubsetType := dsExternal;
+        ParseMarkupDecl;
+      finally
+        Src.DTDSubsetType := dsNone;
+        ContextPop;
+      end;
+    end
+    else
+      ValidationError('Unable to resolve external DTD subset', []);
   end;
   FCursor := Doc;
   ValidateDTD;
@@ -2847,13 +2924,10 @@ begin
     ValidationError('Comments are not allowed within EMPTY elements', []);
 
   // DOM builder part
-  if (not FIgnoreComments) then
+  if (not FIgnoreComments) and Assigned(FCursor) then
   begin
     Node := Doc.CreateCommentBuf(ch, Count);
-    if Assigned(FCursor) then
-      FCursor.AppendChild(Node)
-    else
-      Doc.InsertBefore(Node, FDocType);
+    FCursor.AppendChild(Node);
   end;
 end;