From 22d1077cf49501db398ee7436aea2bf923039b21 Mon Sep 17 00:00:00 2001 From: sergei Date: Tue, 15 May 2012 12:08:58 +0000 Subject: [PATCH] * 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 | 105 ++++++++++++---------- packages/fcl-registry/tests/testbasics.pp | 91 +++++++++++++++---- 2 files changed, 134 insertions(+), 62 deletions(-) diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp index 1fca47aae2..0eef82d6be 100644 --- a/packages/fcl-registry/src/xmlreg.pp +++ b/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 results in , 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; diff --git a/packages/fcl-registry/tests/testbasics.pp b/packages/fcl-registry/tests/testbasics.pp index 6de7106e84..91bfadd9d9 100644 --- a/packages/fcl-registry/tests/testbasics.pp +++ b/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