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

* TDOMDocument now checks its children and allows only a single Element/DocType child. This fixes about 8 test cases at Level 3.

Browse Source 
+ Initial moves to implement TDOMNode.BaseURI (not yet functional)

git-svn-id: trunk@13809 -
This commit is contained in:
sergei 2009-10-06 11:03:25 +00:00
parent 6113876842
commit 4d2e6bac7f
2 changed files with 54 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
packages/fcl-xml/src/dom.pp
View File

@ -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
@ -258,6 +259,7 @@ type
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;
@ -453,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;
@ -1239,6 +1243,22 @@ begin
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 := '';
end;
end;
//------------------------------------------------------------------------------
function CompareDOMNodeWithDOMNode(Node1, Node2: Pointer): integer;
@ -2212,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;

16
packages/fcl-xml/src/xmlread.pp
View File

@ -94,7 +94,7 @@ type
private
FStream: TStream;
FStringData: string;
// FBaseURI: WideString;
FBaseURI: WideString;
FSystemID: WideString;
FPublicID: WideString;
// FEncoding: string;
@ -103,7 +103,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;
@ -435,7 +435,7 @@ type
procedure ExpectChoiceOrSeq(CP: TContentParticle);
procedure ParseElementDecl;
procedure ParseNotationDecl;
function ResolveEntity(const AbsSysID, PublicID: WideString; out Source: TXMLCharSource): Boolean;
function ResolveEntity(const AbsSysID, 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);
@ -744,7 +744,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);
@ -1164,7 +1164,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,7 +1176,7 @@ begin
Loc.LinePos := FSource.FBuf-FSource.LFPos;
end;
function TXMLReader.ResolveEntity(const AbsSysID, PublicID: WideString; out Source: TXMLCharSource): Boolean;
function TXMLReader.ResolveEntity(const AbsSysID, PublicID, BaseURI: WideString; out Source: TXMLCharSource): Boolean;
var
Filename: string;
Stream: TStream;
@ -1732,7 +1732,7 @@ var
begin
if (AEntity.SystemID <> '') and not AEntity.FResolved then
begin
Result := ResolveEntity(AEntity.FURI, AEntity.PublicID, Src);
Result := ResolveEntity(AEntity.FURI, AEntity.PublicID, '', Src);
if not Result then
begin
// TODO: a detailed message like SysErrorMessage(GetLastError) would be great here
@ -2180,7 +2180,7 @@ begin
if (FDocType.SystemID <> '') then
begin
ResolveRelativeURI(FSource.SystemID, FDocType.SystemID, DoctypeURI);
if ResolveEntity(DocTypeURI, FDocType.PublicID, Src) then
if ResolveEntity(DocTypeURI, FDocType.PublicID, '', Src) then
begin
Initialize(Src);
try