mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 05:30:57 +02:00
* 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 -
This commit is contained in:
sergei
parent
c628942e15
commit
22d1077cf4
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user