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;
   DataNode : TDomNode;
   ND : Integer;
-  Dt : TDataType;
   S : AnsiString;
-
+  HasData: Boolean;
+  IntValue: Integer;
 begin
   Node:=FindValueKey(Name);
   Result:=Node<>Nil;
   If Result then
     begin
     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
       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);
-                    end;
-          dtString : begin
+                    end
+                  else
+                    Result:=False;
+                  end;
+        dtString : begin  // DataNode is optional
+                   if HasData then
+                     begin
                      S:=DataNode.NodeValue; // Convert to ansistring
                      DataSize:=Length(S);
-                     If (DataSize>0) then
+                     if (DataSize>0) then
                        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);
                      If (DataSize>0) then
                        HexToBuf(DataNode.NodeValue,Data,DataSize);
-                     end;
-        end;
-        end;
+                     end
+                   else
+                     DataSize:=0;
+                   end;
+      end;
       end;
     end;
 end;
@@ -339,10 +351,7 @@ Type
 Var
   Node  : TDomElement;
   DataNode : TDomNode;
-  ND : Integer;
-  Dt : TDataType;
   S : String;
-
 begin
   Node:=FindValueKey(Name);
   If Node=Nil then
@@ -352,28 +361,28 @@ begin
     begin
     Node[SType]:=IntToStr(Ord(DataType));
     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
-      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;
-  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;
     MaybeFlush;
     end;
@@ -534,6 +543,7 @@ Var
 begin
   P:=@Buf;
   Len:= Length(Str) div 2;
+  Result:=0;
   For I:=0 to Len-1 do
     begin
     S:='$'+Copy(Str,(I*2)+1,2);
@@ -592,22 +602,25 @@ Function TXMLRegistry.GetValueInfo(Name : String; Var Info : TDataInfo) : Boolea
 Var
   N  : TDomElement;
   DN : TDomNode;
+  L : Integer;
 begin
   N:=FindValueKey(Name);
   Result:=(N<>Nil);
   If Result then
     begin
     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
       begin
       DataType:=TDataType(StrToIntDef(N[SType],0));
       Case DataType of
         dtUnknown : DataSize:=0;
         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;

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

@@ -21,7 +21,8 @@ end;
 Procedure TRegistry.SysRegFree;
 
 begin
-  TXMLRegistry(FSysData).Flush;
+  if Assigned(FSysData) then
+    TXMLRegistry(FSysData).Flush;
   TXMLRegistry(FSysData).Free;
 end;
 
@@ -237,13 +238,21 @@ end;
 procedure TRegistry.CloseKey;
 
 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;
 
 procedure TRegistry.CloseKey(key:HKEY);
 
 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;

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

@@ -16,10 +16,12 @@ type
 
   TTestBasics = class(TTestCase)
   private
+    procedure DeleteUserXmlFile;
   protected
   published
     procedure TestSimpleWinRegistry;
     procedure TestDoubleWrite;
+    procedure bug16395;
   end;
 
 implementation
@@ -29,6 +31,19 @@ uses
 
 { 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;
 var
   Registry : TRegistry;
@@ -46,18 +61,8 @@ begin
 end;
 
 procedure TTestBasics.TestDoubleWrite;
-
-{$ifndef windows}
-Var
-  FN : String;
-{$endif}
-
 begin
-{$ifndef windows}
-  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
-  if FileExists(FN) then
-    AssertTrue(DeleteFile(FN));
-{$endif}
+  DeleteUserXmlFile;
   with TRegistry.Create do
     try
       OpenKey('test', true);
@@ -74,11 +79,65 @@ begin
     finally
       Free;
     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;
 
 initialization

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

@@ -98,7 +98,6 @@ type
   TDOMEntityReference = class;
   TDOMProcessingInstruction = class;
 
-  TDOMAttrDef = class;
   TNodePool = class;
   PNodePoolArray = ^TNodePoolArray;
   TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
@@ -485,7 +484,6 @@ type
       TDOMProcessingInstruction; virtual;
     function CreateAttribute(const name: DOMString): TDOMAttr;
     function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
-    function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef; deprecated;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference;
       virtual;
     function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
@@ -503,7 +501,6 @@ type
     // Extensions to DOM interface:
     constructor Create; virtual;
     destructor Destroy; override;
-    function AddID(Attr: TDOMAttr): Boolean; deprecated;
     function CloneNode(deep: Boolean): TDOMNode; overload; override;
     property Names: THashTable read FNames;
     property IDs: THashTable read FIDList write FIDList;
@@ -522,8 +519,6 @@ type
     function CreateProcessingInstruction(const target, data: DOMString):
       TDOMProcessingInstruction; 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;
 
   // This limits number of namespaces per document to 65535,
@@ -763,26 +758,6 @@ type
     property Data: DOMString read FNodeValue write SetNodeValue;
   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
 // One pool manages objects of the same InstanceSize (may be of various classes)
 
@@ -2220,22 +2195,6 @@ begin
   Result := pp.AllocNode(AClass);
 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,
 // or when it is being destroyed
 // TODO: This could be much faster if removing ID happens
@@ -2405,14 +2364,6 @@ begin
   Include(Result.FFlags, nfSpecified);
 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):
   TDOMEntityReference;
 begin
@@ -3420,46 +3371,6 @@ begin
   FNodeValue := AValue;
 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 }
 
 constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);

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

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

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

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

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

@@ -130,9 +130,9 @@ end;
   ---------------------------------------------------------------------}
 
 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];
   QuotStr = '&quot;';
   AmpStr = '&amp;';
@@ -323,7 +323,7 @@ begin
     #10: Sender.wrtStr('&#xA;');
     #13: Sender.wrtStr('&#xD;');
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
 end;
 
@@ -344,7 +344,7 @@ begin
       end;
     #10: Sender.wrtStr(Sender.FLineBreak);
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
 end;
 
@@ -355,9 +355,10 @@ begin
     '<': Sender.wrtStr(ltStr);
     '>': Sender.wrtStr(gtStr);
     '&': Sender.wrtStr(AmpStr);
-    #13: Sender.wrtStr('&#xD;')
+    #13: Sender.wrtStr('&#xD;');
+    #10: Sender.wrtChr(#10);
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
   end;
 end;
 
@@ -371,7 +372,7 @@ begin
     // TODO: emit warning 'cdata-section-splitted'
   end
   else
-    Sender.wrtChr(s[idx]);
+    raise EConvertError.Create('Illegal character');
 end;
 
 const

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

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