Browse Source

--- Merging r19639 into '.':
U packages/fcl-xml/tests/xmlts.pp
--- Merging r19792 into '.':
U packages/fcl-xml/src/xmlwrite.pp
--- Merging r19812 into '.':
U packages/fcl-xml/src/sax_xml.pp
U packages/fcl-xml/src/sax_html.pp
--- Merging r20406 into '.':
U packages/fcl-xml/src/dom.pp
--- Merging r20879 into '.':
U packages/fcl-xml/src/sax.pp
--- Merging r21292 into '.':
U packages/fcl-xml/src/htmlwriter.pp
--- Merging r21293 into '.':
U packages/fcl-registry/src/xregreg.inc
--- Merging r21299 into '.':
U packages/fcl-registry/tests/testbasics.pp
U packages/fcl-registry/src/xmlreg.pp

# revisions: 19639,19792,19812,20406,20879,21292,21293,21299
r19639 | sergei | 2011-11-14 23:58:48 +0100 (Mon, 14 Nov 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-xml/tests/xmlts.pp

* Changed Utf8String to AnsiString, fixes compilation after merging of cpstring.
r19792 | sergei | 2011-12-10 01:43:48 +0100 (Sat, 10 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-xml/src/xmlwrite.pp

* XML writer: reject characters in range #0-#31 (excluding #9,#10,#13) in text node and attribute contents. Resolves #20780.
r19812 | sergei | 2011-12-11 05:15:26 +0100 (Sun, 11 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-xml/src/sax_html.pp
M /trunk/packages/fcl-xml/src/sax_xml.pp

- removed 'var' parameter, it isn't necessary and prevents passing TStream descendants (Mantis #20867).
r20406 | sergei | 2012-02-22 23:23:36 +0100 (Wed, 22 Feb 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-xml/src/dom.pp

- fcl-xml, removed stuff which was deprecated in 2.6.
r20879 | sergei | 2012-04-15 00:44:45 +0200 (Sun, 15 Apr 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-xml/src/sax.pp

* SAX cleanup: removed {$ifdef UseDynArrays}, left variant without dynarrays, they don't provide any significant advantage.
* Changed TList to TFPList, removed redundant FLength field.
r21292 | sergei | 2012-05-14 15:28:52 +0200 (Mon, 14 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-xml/src/htmlwriter.pp

* Fixed class cast error (THTMLDocument is not a descendant of THTMLCustomElement).
r21293 | sergei | 2012-05-14 16:28:48 +0200 (Mon, 14 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-registry/src/xregreg.inc

* TRegistry (XML flavor): check if FSysData is actually assigned in methods that are called from destructor. Destructor is executed when an exception occurs in constructor, but FSysData may not yet be assigned in this case.
r21299 | sergei | 2012-05-15 14:08:58 +0200 (Tue, 15 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-registry/src/xmlreg.pp
M /trunk/packages/fcl-registry/tests/testbasics.pp

* TXMLRegistry: treat absent child text node as empty value for string and binary types. This is necessary because xml does not preserve empty text nodes. Resolves #16395.
+ Test

git-svn-id: branches/fixes_2_6@21457 -

marco 13 years ago
parent
commit
9c862ec602

+ 59 - 46
packages/fcl-registry/src/xmlreg.pp

@@ -292,41 +292,53 @@ Var
   Node  : TDomElement;
   Node  : TDomElement;
   DataNode : TDomNode;
   DataNode : TDomNode;
   ND : Integer;
   ND : Integer;
-  Dt : TDataType;
   S : AnsiString;
   S : AnsiString;
-
+  HasData: Boolean;
+  IntValue: Integer;
 begin
 begin
   Node:=FindValueKey(Name);
   Node:=FindValueKey(Name);
   Result:=Node<>Nil;
   Result:=Node<>Nil;
   If Result then
   If Result then
     begin
     begin
     DataNode:=Node.FirstChild;
     DataNode:=Node.FirstChild;
-    Result:=(DataNode<>Nil) and (DataNode is TDomText);
+    HasData:=Assigned(DataNode) and (DataNode.NodeType=TEXT_NODE);
+    ND:=StrToIntDef(Node[Stype],0);
+    Result:=ND<=Ord(High(TDataType));
     If Result then
     If Result then
       begin
       begin
-      ND:=StrToIntDef(Node[Stype],0);
-      Result:=ND<=Ord(High(TDataType));
-      If Result then
-        begin
-        DataType:=TDataType(StrToIntDef(Node[Stype],0));
-        Case DataType of
-          dtDWORD : begin
-                    PCardinal(@Data)^:=StrToIntDef(DataNode.NodeValue,0);
+      DataType:=TDataType(ND);
+      Case DataType of
+        dtDWORD : begin   // DataNode is required
+                  if HasData and TryStrToInt(DataNode.NodeValue,IntValue) then
+                    begin
+                    PCardinal(@Data)^:=IntValue;
                     DataSize:=SizeOf(Cardinal);
                     DataSize:=SizeOf(Cardinal);
-                    end;
-          dtString : begin
+                    end
+                  else
+                    Result:=False;
+                  end;
+        dtString : begin  // DataNode is optional
+                   if HasData then
+                     begin
                      S:=DataNode.NodeValue; // Convert to ansistring
                      S:=DataNode.NodeValue; // Convert to ansistring
                      DataSize:=Length(S);
                      DataSize:=Length(S);
-                     If (DataSize>0) then
+                     if (DataSize>0) then
                        Move(S[1],Data,DataSize);
                        Move(S[1],Data,DataSize);
-                     end;
-          dtBinary : begin
+                     end
+                   else
+                     DataSize:=0;
+                   end;
+        dtBinary : begin  // DataNode is optional
+                   if HasData then
+                     begin
                      DataSize:=Length(DataNode.NodeValue);
                      DataSize:=Length(DataNode.NodeValue);
                      If (DataSize>0) then
                      If (DataSize>0) then
                        HexToBuf(DataNode.NodeValue,Data,DataSize);
                        HexToBuf(DataNode.NodeValue,Data,DataSize);
-                     end;
-        end;
-        end;
+                     end
+                   else
+                     DataSize:=0;
+                   end;
+      end;
       end;
       end;
     end;
     end;
 end;
 end;
@@ -339,10 +351,7 @@ Type
 Var
 Var
   Node  : TDomElement;
   Node  : TDomElement;
   DataNode : TDomNode;
   DataNode : TDomNode;
-  ND : Integer;
-  Dt : TDataType;
   S : String;
   S : String;
-
 begin
 begin
   Node:=FindValueKey(Name);
   Node:=FindValueKey(Name);
   If Node=Nil then
   If Node=Nil then
@@ -352,28 +361,28 @@ begin
     begin
     begin
     Node[SType]:=IntToStr(Ord(DataType));
     Node[SType]:=IntToStr(Ord(DataType));
     DataNode:=Node.FirstChild;
     DataNode:=Node.FirstChild;
-    // Reading <value></value> results in <value/>, i.e. no subkey exists any more. Create textnode.
-    if (DataNode=nil) then
-      begin
-      DataNode:=FDocument.CreateTextNode('');
-      Node.AppendChild(DataNode);
-      end;
+
     Case DataType of
     Case DataType of
-      dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
-      dtString : begin
-                 SetLength(S,DataSize);
-                 If (DataSize>0) then
-                   Move(Data,S[1],DataSize);
-                 DataNode.NodeValue:=S;
-                 end;
-      dtBinary : begin
-                 S:=BufToHex(Data,DataSize);
-                 DataNode.NodeValue:=S;
-                 end;
-      end;
+      dtDWORD : S:=IntToStr(PCardinal(@Data)^);
+      dtString : SetString(S, PAnsiChar(@Data), DataSize);
+      dtBinary : S:=BufToHex(Data,DataSize);
+    else
+      s:='';
     end;
     end;
-  If Result then
-    begin
+    if s <> '' then
+      begin
+      if DataNode=nil then
+        begin
+        // may happen if previous value was empty;
+        // XML does not handle empty textnodes.
+        DataNode:=FDocument.CreateTextNode(s);
+        Node.AppendChild(DataNode);
+        end
+      else
+        DataNode.NodeValue:=s;
+      end
+    else
+      DataNode.Free;
     FDirty:=True;
     FDirty:=True;
     MaybeFlush;
     MaybeFlush;
     end;
     end;
@@ -534,6 +543,7 @@ Var
 begin
 begin
   P:=@Buf;
   P:=@Buf;
   Len:= Length(Str) div 2;
   Len:= Length(Str) div 2;
+  Result:=0;
   For I:=0 to Len-1 do
   For I:=0 to Len-1 do
     begin
     begin
     S:='$'+Copy(Str,(I*2)+1,2);
     S:='$'+Copy(Str,(I*2)+1,2);
@@ -592,22 +602,25 @@ Function TXMLRegistry.GetValueInfo(Name : String; Var Info : TDataInfo) : Boolea
 Var
 Var
   N  : TDomElement;
   N  : TDomElement;
   DN : TDomNode;
   DN : TDomNode;
+  L : Integer;
 begin
 begin
   N:=FindValueKey(Name);
   N:=FindValueKey(Name);
   Result:=(N<>Nil);
   Result:=(N<>Nil);
   If Result then
   If Result then
     begin
     begin
     DN:=N.FirstChild;
     DN:=N.FirstChild;
-    Result:=DN<>Nil;
-    If Result then
+    if Assigned(DN) and (DN.NodeType=TEXT_NODE) then
+      L:=TDOMText(DN).Length
+    else
+      L:=0;
     With Info do
     With Info do
       begin
       begin
       DataType:=TDataType(StrToIntDef(N[SType],0));
       DataType:=TDataType(StrToIntDef(N[SType],0));
       Case DataType of
       Case DataType of
         dtUnknown : DataSize:=0;
         dtUnknown : DataSize:=0;
         dtDword   : Datasize:=SizeOf(Cardinal);
         dtDword   : Datasize:=SizeOf(Cardinal);
-        dtString  : DataSize:=Length(DN.NodeValue);
-        dtBinary  : DataSize:=Length(DN.NodeValue) div 2;
+        dtString  : DataSize:=L;
+        dtBinary  : DataSize:=L div 2;
       end;
       end;
       end;
       end;
     end;
     end;

+ 14 - 5
packages/fcl-registry/src/xregreg.inc

@@ -21,7 +21,8 @@ end;
 Procedure TRegistry.SysRegFree;
 Procedure TRegistry.SysRegFree;
 
 
 begin
 begin
-  TXMLRegistry(FSysData).Flush;
+  if Assigned(FSysData) then
+    TXMLRegistry(FSysData).Flush;
   TXMLRegistry(FSysData).Free;
   TXMLRegistry(FSysData).Free;
 end;
 end;
 
 
@@ -237,13 +238,21 @@ end;
 procedure TRegistry.CloseKey;
 procedure TRegistry.CloseKey;
 
 
 begin
 begin
-  TXMLRegistry(FSysData).Flush;
-  TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+  // CloseKey is called from destructor, which includes cases of failed construction.
+  // FSysData may be unassigned at this point.
+  if Assigned(FSysData) then
+  begin
+    TXMLRegistry(FSysData).Flush;
+    TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+  end;
 end;
 end;
 
 
 procedure TRegistry.CloseKey(key:HKEY);
 procedure TRegistry.CloseKey(key:HKEY);
 
 
 begin
 begin
-  TXMLRegistry(FSysData).Flush;
-  TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+  if Assigned(FSysData) then
+  begin
+    TXMLRegistry(FSysData).Flush;
+    TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+  end;
 end;
 end;

+ 75 - 16
packages/fcl-registry/tests/testbasics.pp

@@ -16,10 +16,12 @@ type
 
 
   TTestBasics = class(TTestCase)
   TTestBasics = class(TTestCase)
   private
   private
+    procedure DeleteUserXmlFile;
   protected
   protected
   published
   published
     procedure TestSimpleWinRegistry;
     procedure TestSimpleWinRegistry;
     procedure TestDoubleWrite;
     procedure TestDoubleWrite;
+    procedure bug16395;
   end;
   end;
 
 
 implementation
 implementation
@@ -29,6 +31,19 @@ uses
 
 
 { TTestBasics }
 { TTestBasics }
 
 
+procedure TTestBasics.DeleteUserXmlFile;
+{$ifndef windows}
+var
+  fn: string;
+{$endif}
+begin
+{$ifndef windows}
+  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
+  if FileExists(FN) then
+    AssertTrue(DeleteFile(FN));
+{$endif}
+end;
+
 procedure TTestBasics.TestSimpleWinRegistry;
 procedure TTestBasics.TestSimpleWinRegistry;
 var
 var
   Registry : TRegistry;
   Registry : TRegistry;
@@ -46,18 +61,8 @@ begin
 end;
 end;
 
 
 procedure TTestBasics.TestDoubleWrite;
 procedure TTestBasics.TestDoubleWrite;
-
-{$ifndef windows}
-Var
-  FN : String;
-{$endif}
-
 begin
 begin
-{$ifndef windows}
-  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
-  if FileExists(FN) then
-    AssertTrue(DeleteFile(FN));
-{$endif}
+  DeleteUserXmlFile;
   with TRegistry.Create do
   with TRegistry.Create do
     try
     try
       OpenKey('test', true);
       OpenKey('test', true);
@@ -74,11 +79,65 @@ begin
     finally
     finally
       Free;
       Free;
     end;
     end;
-{$ifndef windows}
-  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
-  if FileExists(FN) then
-    AssertTrue(DeleteFile(FN));
-{$endif}
+  DeleteUserXmlFile;
+end;
+
+procedure TTestBasics.bug16395;
+var
+  r: TRegistry;
+  s: string;
+begin
+  DeleteUserXmlFile;
+  
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('FirstNode', true);
+    r.WriteString('string1', '');
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
+  // verify that empty value can be changed to non-empty one
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('FirstNode',false);
+    s := r.ReadString('string1');
+    AssertEquals('Failed to read back an empty string', '', s);
+    r.WriteString('string1', 'string_value_1');
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
+  // verify that non-empty value can be changed to empty one
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('FirstNode',false);
+    s := r.ReadString('string1');
+    AssertEquals('Failed chaning empty string value to non-empty one', 'string_value_1',s);
+
+    r.WriteString('string1', '');
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('FirstNode',false);
+    s := r.ReadString('string1');
+    AssertEquals('Failed changing non-empty string value to empty one', '', s);
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
+  DeleteUserXmlFile;
 end;
 end;
 
 
 initialization
 initialization

+ 0 - 89
packages/fcl-xml/src/dom.pp

@@ -98,7 +98,6 @@ type
   TDOMEntityReference = class;
   TDOMEntityReference = class;
   TDOMProcessingInstruction = class;
   TDOMProcessingInstruction = class;
 
 
-  TDOMAttrDef = class;
   TNodePool = class;
   TNodePool = class;
   PNodePoolArray = ^TNodePoolArray;
   PNodePoolArray = ^TNodePoolArray;
   TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
   TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
@@ -485,7 +484,6 @@ type
       TDOMProcessingInstruction; virtual;
       TDOMProcessingInstruction; virtual;
     function CreateAttribute(const name: DOMString): TDOMAttr;
     function CreateAttribute(const name: DOMString): TDOMAttr;
     function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
     function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
-    function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef; deprecated;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference;
       virtual;
       virtual;
     function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
     function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
@@ -503,7 +501,6 @@ type
     // Extensions to DOM interface:
     // Extensions to DOM interface:
     constructor Create; virtual;
     constructor Create; virtual;
     destructor Destroy; override;
     destructor Destroy; override;
-    function AddID(Attr: TDOMAttr): Boolean; deprecated;
     function CloneNode(deep: Boolean): TDOMNode; overload; override;
     function CloneNode(deep: Boolean): TDOMNode; overload; override;
     property Names: THashTable read FNames;
     property Names: THashTable read FNames;
     property IDs: THashTable read FIDList write FIDList;
     property IDs: THashTable read FIDList write FIDList;
@@ -522,8 +519,6 @@ type
     function CreateProcessingInstruction(const target, data: DOMString):
     function CreateProcessingInstruction(const target, data: DOMString):
       TDOMProcessingInstruction; override;
       TDOMProcessingInstruction; override;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
-    // non-compliant symbol, superseded by XMLEncoding, to be phased out
-    property Encoding: DOMString read FXMLEncoding write FXMLEncoding; deprecated;
   end;
   end;
 
 
   // This limits number of namespaces per document to 65535,
   // This limits number of namespaces per document to 65535,
@@ -763,26 +758,6 @@ type
     property Data: DOMString read FNodeValue write SetNodeValue;
     property Data: DOMString read FNodeValue write SetNodeValue;
   end;
   end;
 
 
-// Attribute declaration - Attr descendant which carries rudimentary type info
-// must be severely improved while developing Level 3
-// NOT USED ANYMORE -- replaced by dtdmodel.TAttributeDef
-
-  TAttrDefault = dtdmodel.TAttrDefault;
-  TDOMAttrDef = class(TDOMAttr)
-  protected
-    FExternallyDeclared: Boolean;
-    FDefault: TAttrDefault;
-    FTag: Cardinal;
-    FEnumeration: array of DOMString;
-  public
-    function AddEnumToken(Buf: DOMPChar; Len: Integer): Boolean;
-    function HasEnumToken(const aValue: DOMString): Boolean;
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
-    property Default: TAttrDefault read FDefault write FDefault;
-    property ExternallyDeclared: Boolean read FExternallyDeclared write FExternallyDeclared;
-    property Tag: Cardinal read FTag write FTag;
-  end deprecated;
-
 // TNodePool - custom memory management for TDOMNode's
 // TNodePool - custom memory management for TDOMNode's
 // One pool manages objects of the same InstanceSize (may be of various classes)
 // One pool manages objects of the same InstanceSize (may be of various classes)
 
 
@@ -2220,22 +2195,6 @@ begin
   Result := pp.AllocNode(AClass);
   Result := pp.AllocNode(AClass);
 end;
 end;
 
 
-function TDOMDocument.AddID(Attr: TDOMAttr): Boolean;
-var
-  ID: DOMString;
-  Exists: Boolean;
-  p: PHashItem;
-begin
-  if FIDList = nil then
-    FIDList := THashTable.Create(256, False);
-
-  ID := Attr.Value;
-  p := FIDList.FindOrAdd(DOMPChar(ID), Length(ID), Exists);
-  if not Exists then
-    p^.Data := Attr.FParentNode;
-  Result := not Exists;
-end;
-
 // This shouldn't be called if document has no IDs,
 // This shouldn't be called if document has no IDs,
 // or when it is being destroyed
 // or when it is being destroyed
 // TODO: This could be much faster if removing ID happens
 // TODO: This could be much faster if removing ID happens
@@ -2405,14 +2364,6 @@ begin
   Include(Result.FFlags, nfSpecified);
   Include(Result.FFlags, nfSpecified);
 end;
 end;
 
 
-{deprecated}
-function TDOMDocument.CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef;
-begin
-// not using custom allocation here
-  Result := TDOMAttrDef.Create(Self);
-  Result.FNSI.QName := FNames.FindOrAdd(Buf, Length);
-end;
-
 function TDOMDocument.CreateEntityReference(const name: DOMString):
 function TDOMDocument.CreateEntityReference(const name: DOMString):
   TDOMEntityReference;
   TDOMEntityReference;
 begin
 begin
@@ -3420,46 +3371,6 @@ begin
   FNodeValue := AValue;
   FNodeValue := AValue;
 end;
 end;
 
 
-{ TDOMAttrDef (DEPRECATED) }
-
-function TDOMAttrDef.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-begin
-  Result := inherited CloneNode(deep, ACloneOwner);
-  Exclude(Result.FFlags, nfSpecified);
-end;
-
-function TDOMAttrDef.AddEnumToken(Buf: DOMPChar; Len: Integer): Boolean;
-var
-  I, L: Integer;
-begin
-  // TODO: this implementaion is the slowest possible...
-  Result := False;
-  L := Length(FEnumeration);
-  for I := 0 to L-1 do
-  begin
-    if CompareDomStrings(Buf, DOMPChar(FEnumeration[I]), Len, Length(FEnumeration[I])) = 0 then
-      Exit;
-  end;
-  SetLength(FEnumeration, L+1);
-  SetString(FEnumeration[L], Buf, Len);
-  Result := True;
-end;
-
-function TDOMAttrDef.HasEnumToken(const aValue: DOMString): Boolean;
-var
-  I: Integer;
-begin
-  Result := True;
-  if Length(FEnumeration) = 0 then
-    Exit;
-  for I := 0 to Length(FEnumeration)-1 do
-  begin
-    if FEnumeration[I] = aValue then
-      Exit;
-  end;
-  Result := False;
-end;
-
 { TNodePool }
 { TNodePool }
 
 
 constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);
 constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);

+ 4 - 1
packages/fcl-xml/src/htmlwriter.pp

@@ -132,7 +132,10 @@ begin
   if assigned (d) then
   if assigned (d) then
     begin
     begin
     result := THTMLCustomElement(d);
     result := THTMLCustomElement(d);
-    FCurrentElement := THTMLCustomElement(result.ParentNode);
+    if result.ParentNode = FDocument then
+      FCurrentElement := nil
+    else
+      FCurrentElement := THTMLCustomElement(result.ParentNode);
     end
     end
   else
   else
     raise HTMLWriterException.CreateFmt (sErrNoCorespondingParent, [tag.ClassName]);
     raise HTMLWriterException.CreateFmt (sErrNoCorespondingParent, [tag.ClassName]);

+ 31 - 97
packages/fcl-xml/src/sax.pp

@@ -77,27 +77,18 @@ type
     AttrType: String;
     AttrType: String;
   end;
   end;
 
 
-  {$IFNDEF UseDynArrays}
   PSAXAttributeData = ^TSAXAttributeData;
   PSAXAttributeData = ^TSAXAttributeData;
-  {$ENDIF}
 
 
   TSAXAttributes = class
   TSAXAttributes = class
   protected
   protected
-    FLength: Integer;
-    {$IFDEF UseDynArrays}
-    Data: array of TSAXAttributeData;
-    {$ELSE}
-    FData: TList;
+    FData: TFPList;
     function GetData(Index: Integer): PSAXAttributeData;
     function GetData(Index: Integer): PSAXAttributeData;
     property Data[Index:Integer]: PSAXAttributeData read GetData;
     property Data[Index:Integer]: PSAXAttributeData read GetData;
-    {$ENDIF}
     procedure BadIndex(Index: Integer);
     procedure BadIndex(Index: Integer);
   public
   public
     constructor Create; overload;
     constructor Create; overload;
     constructor Create(Atts: TSAXAttributes); overload;
     constructor Create(Atts: TSAXAttributes); overload;
-    {$IFNDEF UseDynArrays}
     destructor Destroy; override;
     destructor Destroy; override;
-    {$ENDIF}
 
 
     function GetIndex(const QName: SAXString): Integer; overload;
     function GetIndex(const QName: SAXString): Integer; overload;
     function GetIndex(const URI, LocalPart: SAXString): Integer; overload;
     function GetIndex(const URI, LocalPart: SAXString): Integer; overload;
@@ -313,33 +304,27 @@ end;
 constructor TSAXAttributes.Create;
 constructor TSAXAttributes.Create;
 begin
 begin
   inherited Create;
   inherited Create;
-  {$IFNDEF UseDynArrays}
-  FData := TList.Create;
-  {$ENDIF}
+  FData := TFPList.Create;
 end;
 end;
 
 
 constructor TSAXAttributes.Create(Atts: TSAXAttributes);
 constructor TSAXAttributes.Create(Atts: TSAXAttributes);
 begin
 begin
   inherited Create;
   inherited Create;
-  {$IFNDEF UseDynArrays}
-  FData := TList.Create;
-  {$ENDIF}
+  FData := TFPList.Create;
   SetAttributes(Atts);
   SetAttributes(Atts);
 end;
 end;
 
 
-{$IFNDEF UseDynArrays}
 destructor TSAXAttributes.Destroy;
 destructor TSAXAttributes.Destroy;
 begin
 begin
   Clear;
   Clear;
   FData.Free;
   FData.Free;
   inherited Destroy;
   inherited Destroy;
 end;
 end;
-{$ENDIF}
 
 
 function TSAXAttributes.GetIndex(const QName: SAXString): Integer;
 function TSAXAttributes.GetIndex(const QName: SAXString): Integer;
 begin
 begin
   Result := 0;
   Result := 0;
-  while Result < FLength do
+  while Result < FData.Count do
   begin
   begin
     if Data[Result]^.QName = QName then
     if Data[Result]^.QName = QName then
       exit;
       exit;
@@ -351,7 +336,7 @@ end;
 function TSAXAttributes.GetIndex(const URI, LocalPart: SAXString): Integer;
 function TSAXAttributes.GetIndex(const URI, LocalPart: SAXString): Integer;
 begin
 begin
   Result := 0;
   Result := 0;
-  while Result < FLength do
+  while Result < FData.Count do
   begin
   begin
     if (Data[Result]^.URI = URI) and (Data[Result]^.LocalName = LocalPart) then
     if (Data[Result]^.URI = URI) and (Data[Result]^.LocalName = LocalPart) then
       exit;
       exit;
@@ -362,12 +347,12 @@ end;
 
 
 function TSAXAttributes.GetLength: Integer;
 function TSAXAttributes.GetLength: Integer;
 begin
 begin
-  Result := FLength;
+  Result := FData.Count;
 end;
 end;
 
 
 function TSAXAttributes.GetLocalName(Index: Integer): SAXString;
 function TSAXAttributes.GetLocalName(Index: Integer): SAXString;
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Result := Data[Index]^.LocalName
     Result := Data[Index]^.LocalName
   else
   else
     SetLength(Result, 0);
     SetLength(Result, 0);
@@ -375,7 +360,7 @@ end;
 
 
 function TSAXAttributes.GetQName(Index: Integer): SAXString;
 function TSAXAttributes.GetQName(Index: Integer): SAXString;
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Result := Data[Index]^.QName
     Result := Data[Index]^.QName
   else
   else
     SetLength(Result, 0);
     SetLength(Result, 0);
@@ -383,7 +368,7 @@ end;
 
 
 function TSAXAttributes.GetType(Index: Integer): String;
 function TSAXAttributes.GetType(Index: Integer): String;
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Result := Data[Index]^.AttrType
     Result := Data[Index]^.AttrType
   else
   else
     SetLength(Result, 0);
     SetLength(Result, 0);
@@ -393,7 +378,7 @@ function TSAXAttributes.GetType(const QName: SAXString): String;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  for i := 0 to FLength - 1 do
+  for i := 0 to FData.Count - 1 do
     if Data[i]^.QName = QName then
     if Data[i]^.QName = QName then
     begin
     begin
       Result := Data[i]^.AttrType;
       Result := Data[i]^.AttrType;
@@ -406,7 +391,7 @@ function TSAXAttributes.GetType(const URI, LocalName: SAXString): String;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  for i := 0 to FLength - 1 do
+  for i := 0 to FData.Count - 1 do
     if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
     if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
     begin
     begin
       Result := Data[i]^.AttrType;
       Result := Data[i]^.AttrType;
@@ -417,15 +402,15 @@ end;
 
 
 function TSAXAttributes.GetURI(Index: Integer): SAXString;
 function TSAXAttributes.GetURI(Index: Integer): SAXString;
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
-    Result := Data[Index * 5]^.URI
+  if (Index >= 0) and (Index < FData.Count) then
+    Result := Data[Index]^.URI
   else
   else
     SetLength(Result, 0);
     SetLength(Result, 0);
 end;
 end;
 
 
 function TSAXAttributes.GetValue(Index: Integer): SAXString;
 function TSAXAttributes.GetValue(Index: Integer): SAXString;
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Result := Data[Index]^.Value
     Result := Data[Index]^.Value
   else
   else
     SetLength(Result, 0);
     SetLength(Result, 0);
@@ -435,7 +420,7 @@ function TSAXAttributes.GetValue(const QName: SAXString): SAXString;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  for i := 0 to FLength - 1 do
+  for i := 0 to FData.Count - 1 do
     if Data[i]^.QName = QName then
     if Data[i]^.QName = QName then
     begin
     begin
       Result := Data[i]^.Value;
       Result := Data[i]^.Value;
@@ -448,7 +433,7 @@ function TSAXAttributes.GetValue(const URI, LocalName: SAXString): SAXString;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  for i := 0 to FLength - 1 do
+  for i := 0 to FData.Count - 1 do
     if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
     if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
     begin
     begin
       Result := Data[i]^.Value;
       Result := Data[i]^.Value;
@@ -458,39 +443,20 @@ begin
 end;
 end;
 
 
 procedure TSAXAttributes.Clear;
 procedure TSAXAttributes.Clear;
-{$IFDEF UseDynArrays}
-begin
-  SetLength(Data, 0);
-end;
-{$ELSE}
 var
 var
   i: Integer;
   i: Integer;
-  p: PSAXAttributeData;
 begin
 begin
   for i := 0 to FData.Count - 1 do
   for i := 0 to FData.Count - 1 do
-  begin
-    p := PSAXAttributeData(FData[i]);
-    Dispose(p);
-  end;
+    Dispose(PSAXAttributeData(FData[i]));
 end;
 end;
-{$ENDIF}
 
 
 procedure TSAXAttributes.SetAttributes(Atts: TSAXAttributes);
 procedure TSAXAttributes.SetAttributes(Atts: TSAXAttributes);
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  FLength := Atts.Length;
-  {$IFDEF UseDynArrays}
-  SetLength(Data, FLength);
-  {$ELSE}
-  FData.Count := FLength;
-  {$ENDIF}
-  for i := 0 to FLength - 1 do
-    {$IFDEF UseDynArrays}
-    with Data[i] do
-    {$ELSE}
+  FData.Count := Atts.Length;
+  for i := 0 to FData.Count - 1 do
     with Data[i]^ do
     with Data[i]^ do
-    {$ENDIF}
     begin
     begin
       URI := Atts.URIs[i];
       URI := Atts.URIs[i];
       LocalName := Atts.LocalNames[i];
       LocalName := Atts.LocalNames[i];
@@ -502,42 +468,24 @@ end;
 
 
 procedure TSAXAttributes.AddAttribute(const AURI, ALocalName, AQName: SAXString;
 procedure TSAXAttributes.AddAttribute(const AURI, ALocalName, AQName: SAXString;
   const AType: String; const AValue: SAXString);
   const AType: String; const AValue: SAXString);
-{$IFNDEF UseDynArrays}
 var
 var
   p: PSAXAttributeData;
   p: PSAXAttributeData;
-{$ENDIF}
 begin
 begin
-  Inc(FLength);
-  {$IFDEF UseDynArrays}
-  SetLength(Data, FLength);
-  {$ELSE}
   New(p);
   New(p);
   FData.Add(p);
   FData.Add(p);
-  {$ENDIF}
-  {$IFDEF UseDynArrays}
-  with Data[FLength - 1] do
-  {$ELSE}
-  with Data[FLength - 1]^ do
-  {$ENDIF}
-  begin
-    URI := AURI;
-    LocalName := ALocalName;
-    QName := AQName;
-    AttrType := AType;
-    Value := AValue;
-  end;
+  p^.URI := AURI;
+  p^.LocalName := ALocalName;
+  p^.QName := AQName;
+  p^.AttrType := AType;
+  p^.Value := AValue;
 end;
 end;
 
 
 procedure TSAXAttributes.SetAttribute(Index: Integer;
 procedure TSAXAttributes.SetAttribute(Index: Integer;
   const AURI, ALocalName, AQName: SAXString; const AType: String;
   const AURI, ALocalName, AQName: SAXString; const AType: String;
   const AValue: SAXString);
   const AValue: SAXString);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
-    {$IFDEF UseDynArrays}
-    with Data[Index] do
-    {$ELSE}
+  if (Index >= 0) and (Index < FData.Count) then
     with Data[Index]^ do
     with Data[Index]^ do
-    {$ENDIF}
     begin
     begin
       URI := AURI;
       URI := AURI;
       LocalName := ALocalName;
       LocalName := ALocalName;
@@ -550,29 +498,17 @@ begin
 end;
 end;
 
 
 procedure TSAXAttributes.RemoveAttribute(Index: Integer);
 procedure TSAXAttributes.RemoveAttribute(Index: Integer);
-{$IFDEF UseDynArrays}
-var
-  i: Integer;
-{$ENDIF}
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
   begin
   begin
-    {$IFDEF UseDynArrays}
-    for i := Index to FLength - 1 do
-      Data[i] := Data[i + 1];
-    Dec(FLength);
-    SetLength(Data, FLength);
-    {$ELSE}
     FData.Delete(Index);
     FData.Delete(Index);
-    Dec(FLength);
-    {$ENDIF}
   end else
   end else
     BadIndex(Index);
     BadIndex(Index);
 end;
 end;
 
 
 procedure TSAXAttributes.SetURI(Index: Integer; const AURI: SAXString);
 procedure TSAXAttributes.SetURI(Index: Integer; const AURI: SAXString);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Data[Index]^.URI := AURI
     Data[Index]^.URI := AURI
   else
   else
     BadIndex(Index);
     BadIndex(Index);
@@ -581,7 +517,7 @@ end;
 procedure TSAXAttributes.SetLocalName(Index: Integer;
 procedure TSAXAttributes.SetLocalName(Index: Integer;
   const ALocalName: SAXString);
   const ALocalName: SAXString);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Data[Index]^.LocalName := ALocalName
     Data[Index]^.LocalName := ALocalName
   else
   else
     BadIndex(Index);
     BadIndex(Index);
@@ -589,7 +525,7 @@ end;
 
 
 procedure TSAXAttributes.SetQName(Index: Integer; const AQName: SAXString);
 procedure TSAXAttributes.SetQName(Index: Integer; const AQName: SAXString);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Data[Index]^.QName := AQName
     Data[Index]^.QName := AQName
   else
   else
     BadIndex(Index);
     BadIndex(Index);
@@ -597,7 +533,7 @@ end;
 
 
 procedure TSAXAttributes.SetType(Index: Integer; const AType: String);
 procedure TSAXAttributes.SetType(Index: Integer; const AType: String);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Data[Index]^.AttrType := AType
     Data[Index]^.AttrType := AType
   else
   else
     BadIndex(Index);
     BadIndex(Index);
@@ -605,18 +541,16 @@ end;
 
 
 procedure TSAXAttributes.SetValue(Index: Integer; const AValue: SAXString);
 procedure TSAXAttributes.SetValue(Index: Integer; const AValue: SAXString);
 begin
 begin
-  if (Index >= 0) and (Index < FLength) then
+  if (Index >= 0) and (Index < FData.Count) then
     Data[Index]^.Value := AValue
     Data[Index]^.Value := AValue
   else
   else
     BadIndex(Index);
     BadIndex(Index);
 end;
 end;
 
 
-{$IFNDEF UseDynArrays}
 function TSAXAttributes.GetData(Index: Integer): PSAXAttributeData;
 function TSAXAttributes.GetData(Index: Integer): PSAXAttributeData;
 begin
 begin
   Result := PSAXAttributeData(FData[Index]);
   Result := PSAXAttributeData(FData[Index]);
 end;
 end;
-{$ENDIF}
 
 
 procedure TSAXAttributes.BadIndex(Index: Integer);
 procedure TSAXAttributes.BadIndex(Index: Integer);
 begin
 begin

+ 4 - 4
packages/fcl-xml/src/sax_html.pp

@@ -108,10 +108,10 @@ type
 // Helper functions; these ones are HTML equivalents of ReadXML[File|Fragment]
 // Helper functions; these ones are HTML equivalents of ReadXML[File|Fragment]
 
 
 procedure ReadHTMLFile(var ADoc: THTMLDocument; const AFilename: String);
 procedure ReadHTMLFile(var ADoc: THTMLDocument; const AFilename: String);
-procedure ReadHTMLFile(var ADoc: THTMLDocument; var f: TStream);
+procedure ReadHTMLFile(var ADoc: THTMLDocument; f: TStream);
 
 
 procedure ReadHTMLFragment(AParentNode: TDOMNode; const AFilename: String);
 procedure ReadHTMLFragment(AParentNode: TDOMNode; const AFilename: String);
-procedure ReadHTMLFragment(AParentNode: TDOMNode; var f: TStream);
+procedure ReadHTMLFragment(AParentNode: TDOMNode; f: TStream);
 
 
 
 
 
 
@@ -706,7 +706,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure ReadHTMLFile(var ADoc: THTMLDocument; var f: TStream);
+procedure ReadHTMLFile(var ADoc: THTMLDocument; f: TStream);
 var
 var
   Reader: THTMLReader;
   Reader: THTMLReader;
   Converter: THTMLToDOMConverter;
   Converter: THTMLToDOMConverter;
@@ -737,7 +737,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure ReadHTMLFragment(AParentNode: TDOMNode; var f: TStream);
+procedure ReadHTMLFragment(AParentNode: TDOMNode; f: TStream);
 var
 var
   Reader: THTMLReader;
   Reader: THTMLReader;
   Converter: THTMLToDOMConverter;
   Converter: THTMLToDOMConverter;

+ 4 - 4
packages/fcl-xml/src/sax_xml.pp

@@ -95,10 +95,10 @@ type
 // Helper functions; these ones are XML equivalents of ReadXML[File|Fragment]
 // Helper functions; these ones are XML equivalents of ReadXML[File|Fragment]
 
 
 procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
 procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
-procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
+procedure ReadXMLFile(var ADoc: TXMLDocument; f: TStream);
 
 
 procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
 procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
-procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
+procedure ReadXMLFragment(AParentNode: TDOMNode; f: TStream);
 
 
 
 
 
 
@@ -563,7 +563,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
+procedure ReadXMLFile(var ADoc: TXMLDocument; f: TStream);
 var
 var
   Reader: TSAXXMLReader;
   Reader: TSAXXMLReader;
   Converter: TXMLToDOMConverter;
   Converter: TXMLToDOMConverter;
@@ -594,7 +594,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
+procedure ReadXMLFragment(AParentNode: TDOMNode; f: TStream);
 var
 var
   Reader: TSAXXMLReader;
   Reader: TSAXXMLReader;
   Converter: TXMLToDOMConverter;
   Converter: TXMLToDOMConverter;

+ 9 - 8
packages/fcl-xml/src/xmlwrite.pp

@@ -130,9 +130,9 @@ end;
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 const
 const
-  AttrSpecialChars = ['<', '>', '"', '&', #9, #10, #13];
-  TextSpecialChars = ['<', '>', '&', #10, #13];
-  CDSectSpecialChars = [']'];
+  AttrSpecialChars = ['<', '>', '"', '&', #0..#$1F];
+  TextSpecialChars = ['<', '>', '&', #0..#8, #10..#$1F];
+  CDSectSpecialChars = [#0..#8, #11, #12, #14..#$1F, ']'];
   LineEndingChars = [#13, #10];
   LineEndingChars = [#13, #10];
   QuotStr = '&quot;';
   QuotStr = '&quot;';
   AmpStr = '&amp;';
   AmpStr = '&amp;';
@@ -323,7 +323,7 @@ begin
     #10: Sender.wrtStr('&#xA;');
     #10: Sender.wrtStr('&#xA;');
     #13: Sender.wrtStr('&#xD;');
     #13: Sender.wrtStr('&#xD;');
   else
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
   end;
 end;
 end;
 
 
@@ -344,7 +344,7 @@ begin
       end;
       end;
     #10: Sender.wrtStr(Sender.FLineBreak);
     #10: Sender.wrtStr(Sender.FLineBreak);
   else
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
   end;
 end;
 end;
 
 
@@ -355,9 +355,10 @@ begin
     '<': Sender.wrtStr(ltStr);
     '<': Sender.wrtStr(ltStr);
     '>': Sender.wrtStr(gtStr);
     '>': Sender.wrtStr(gtStr);
     '&': Sender.wrtStr(AmpStr);
     '&': Sender.wrtStr(AmpStr);
-    #13: Sender.wrtStr('&#xD;')
+    #13: Sender.wrtStr('&#xD;');
+    #10: Sender.wrtChr(#10);
   else
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
   end;
 end;
 end;
 
 
@@ -371,7 +372,7 @@ begin
     // TODO: emit warning 'cdata-section-splitted'
     // TODO: emit warning 'cdata-section-splitted'
   end
   end
   else
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
 end;
 end;
 
 
 const
 const

+ 7 - 5
packages/fcl-xml/tests/xmlts.pp

@@ -306,10 +306,10 @@ var
   I: Integer;
   I: Integer;
 begin
 begin
   FRootURI := FilenameToURI(Tests);
   FRootURI := FilenameToURI(Tests);
+  writeln('Loading test suite from ', Tests);
   ReadXMLFile(FDoc, Tests);
   ReadXMLFile(FDoc, Tests);
   FSuiteTitle := FDoc.DocumentElement['PROFILE'];
   FSuiteTitle := FDoc.DocumentElement['PROFILE'];
   Cases := FDoc.DocumentElement.GetElementsByTagName('TEST');
   Cases := FDoc.DocumentElement.GetElementsByTagName('TEST');
-  writeln('Using test suite: ', Tests);
   writeln;
   writeln;
   writeln('Testing, validation = ', FValidating);
   writeln('Testing, validation = ', FValidating);
   try
   try
@@ -342,25 +342,27 @@ end;
 
 
 procedure TTestSuite.RunTest(Element: TDOMElement);
 procedure TTestSuite.RunTest(Element: TDOMElement);
 var
 var
-  s: UTF8string;
+  s: string;
   TestType: DOMString;
   TestType: DOMString;
   TempDoc, RefDoc: TXMLDocument;
   TempDoc, RefDoc: TXMLDocument;
   table: TDOMNode;
   table: TDOMNode;
   Positive: Boolean;
   Positive: Boolean;
-  outURI: UTF8string;
+  outURI: string;
   FailMsg: string;
   FailMsg: string;
   ExceptionClass: TClass;
   ExceptionClass: TClass;
   docNode, refNode: TDOMNode;
   docNode, refNode: TDOMNode;
   docMap, refMap: TDOMNamedNodeMap;
   docMap, refMap: TDOMNamedNodeMap;
   docN, refN: TDOMNotation;
   docN, refN: TDOMNotation;
   I: Integer;
   I: Integer;
-  root: UTF8String;
+  root: string;
+  xmlEdition: DOMString;
 begin
 begin
   FErrLine := -1;
   FErrLine := -1;
   FErrCol := -1;
   FErrCol := -1;
   FTestID := Element['ID'];
   FTestID := Element['ID'];
   TestType := Element['TYPE'];
   TestType := Element['TYPE'];
-  if Pos(WideChar('5'), Element['EDITION']) > 0 then
+  xmlEdition := Element['EDITION'];
+  if (xmlEdition <> '') and (Pos(WideChar('5'), Element['EDITION']) > 0) then
   begin
   begin
     Inc(FSkipped);
     Inc(FSkipped);
     Exit;
     Exit;