* 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: trunk@21299 -

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;

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