mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 18:29:13 +02:00
* Extended the tregistry2 test.
git-svn-id: trunk@48203 -
This commit is contained in:
parent
25fd38b2da
commit
4bf19e9d92
@ -1,3 +1,8 @@
|
|||||||
|
{
|
||||||
|
This unit tests mostly TRegIniFile to work properly and be Delphi compatible.
|
||||||
|
Please keep this unit Delphi compatible.
|
||||||
|
}
|
||||||
|
|
||||||
{$ifdef FPC} {$mode delphi} {$endif}
|
{$ifdef FPC} {$mode delphi} {$endif}
|
||||||
unit tregistry2;
|
unit tregistry2;
|
||||||
|
|
||||||
@ -9,6 +14,11 @@ implementation
|
|||||||
|
|
||||||
uses Windows, SysUtils, Classes, registry;
|
uses Windows, SysUtils, Classes, registry;
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
{$WARN implicit_string_cast_loss off}
|
||||||
|
{$WARN symbol_deprecated off}
|
||||||
|
{$endif FPC}
|
||||||
|
|
||||||
const
|
const
|
||||||
STestRegPath = 'Software\FPC-RegTest';
|
STestRegPath = 'Software\FPC-RegTest';
|
||||||
|
|
||||||
@ -17,17 +27,21 @@ begin
|
|||||||
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
|
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure ClearReg;
|
procedure ClearReg(const KeyName: string = '');
|
||||||
begin
|
begin
|
||||||
with TRegistry.Create do
|
with TRegistry.Create do
|
||||||
try
|
try
|
||||||
DeleteKey(STestRegPath + '\1');
|
|
||||||
DeleteKey(STestRegPath);
|
DeleteKey(STestRegPath);
|
||||||
finally
|
finally
|
||||||
Free;
|
Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function NormPath(const s: string): string;
|
||||||
|
begin
|
||||||
|
Result:=StringReplace(s, '/', '\', [rfReplaceAll]);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure DoRegTest2;
|
procedure DoRegTest2;
|
||||||
var
|
var
|
||||||
reg: TRegistry;
|
reg: TRegistry;
|
||||||
@ -36,33 +50,47 @@ var
|
|||||||
sl: TStringList;
|
sl: TStringList;
|
||||||
begin
|
begin
|
||||||
ClearReg;
|
ClearReg;
|
||||||
reg:=TRegistry.Create;
|
|
||||||
try
|
try
|
||||||
if not reg.OpenKey(STestRegPath, True) then
|
reg:=TRegistry.Create;
|
||||||
TestFailed(1);
|
try
|
||||||
if reg.CurrentPath <> STestRegPath then
|
{ The test key must be deleted by ClearReg() }
|
||||||
TestFailed(2);
|
if reg.KeyExists(STestRegPath) then
|
||||||
reg.WriteString('Item1', '1');
|
TestFailed(1);
|
||||||
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
|
if reg.OpenKey(STestRegPath, False) then
|
||||||
TestFailed(3);
|
TestFailed(2);
|
||||||
reg.WriteString('Item2', '2');
|
|
||||||
if reg.CurrentPath <> STestRegPath + '\1' then
|
if not reg.OpenKey(STestRegPath, True) then
|
||||||
TestFailed(5);
|
TestFailed(5);
|
||||||
reg.CloseKey;
|
if NormPath(reg.CurrentPath) <> STestRegPath then
|
||||||
if reg.CurrentPath <> '' then
|
TestFailed(6);
|
||||||
TestFailed(6);
|
reg.WriteString('Item1', '1');
|
||||||
|
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
|
||||||
|
TestFailed(10);
|
||||||
|
reg.WriteString('Item2', '2');
|
||||||
|
if NormPath(reg.CurrentPath) <> STestRegPath + '\1' then
|
||||||
|
TestFailed(15);
|
||||||
|
reg.CloseKey;
|
||||||
|
if NormPath(reg.CurrentPath) <> '' then
|
||||||
|
TestFailed(20);
|
||||||
|
if reg.KeyExists(STestRegPath + '\' + STestRegPath) then
|
||||||
|
TestFailed(21);
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
ri:=TRegIniFile.Create(STestRegPath);
|
ri:=TRegIniFile.Create(STestRegPath);
|
||||||
with ri do
|
with ri do
|
||||||
try
|
try
|
||||||
if ReadString('', 'Item1', '') <> '1' then
|
if ReadString('', 'Item1', '') <> '1' then
|
||||||
TestFailed(10);
|
TestFailed(101);
|
||||||
if ReadString('1', 'Item2', '') <> '2' then
|
if ReadString('1', 'Item2', '') <> '2' then
|
||||||
TestFailed(11);
|
TestFailed(105);
|
||||||
|
if NormPath(ri.CurrentPath) <> STestRegPath then
|
||||||
|
TestFailed(110);
|
||||||
if ReadString('', 'Item1', '') <> '1' then
|
if ReadString('', 'Item1', '') <> '1' then
|
||||||
TestFailed(12);
|
TestFailed(115);
|
||||||
if not ValueExists('Item1') then
|
if not ValueExists('Item1') then
|
||||||
TestFailed(13);
|
TestFailed(120);
|
||||||
|
|
||||||
WriteInteger('1', 'Item3', 3);
|
WriteInteger('1', 'Item3', 3);
|
||||||
|
|
||||||
@ -70,43 +98,118 @@ begin
|
|||||||
try
|
try
|
||||||
ReadSectionValues('1', sl);
|
ReadSectionValues('1', sl);
|
||||||
if sl.Count <> 2 then
|
if sl.Count <> 2 then
|
||||||
TestFailed(14);
|
TestFailed(125);
|
||||||
if sl.Values['Item2'] <> '2' then
|
if sl.Values['Item2'] <> '2' then
|
||||||
TestFailed(15);
|
TestFailed(130);
|
||||||
if sl.Values['Item3'] <> '3' then
|
if sl.Values['Item3'] <> '3' then
|
||||||
TestFailed(16);
|
TestFailed(135);
|
||||||
finally
|
finally
|
||||||
sl.Free;
|
sl.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
WriteInteger('', 'Item4', 4);
|
WriteInteger('', 'Item4', 4);
|
||||||
if GetDataType('Item4') <> rdString then
|
WriteInteger('', 'Item41', 41);
|
||||||
TestFailed(17);
|
WriteInteger('', 'Item42', 42);
|
||||||
|
if GetDataType('Item4') <> rdString then
|
||||||
|
TestFailed(140);
|
||||||
|
if ReadString('', 'Item41', '') <> '41' then
|
||||||
|
TestFailed(141);
|
||||||
|
if ReadString('', 'Item42', '') <> '42' then
|
||||||
|
TestFailed(142);
|
||||||
finally
|
finally
|
||||||
Free;
|
Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ \ at the beginning of the path must be accepted }
|
||||||
|
ri:=TRegIniFile.Create('\' + STestRegPath);
|
||||||
|
with ri do
|
||||||
|
try
|
||||||
|
if ReadString('', 'Item1', '') <> '1' then
|
||||||
|
TestFailed(145);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Write to non-existing key must work }
|
||||||
|
ri:=TRegIniFile.Create(STestRegPath + '\2\3\4');
|
||||||
|
with ri do
|
||||||
|
try
|
||||||
|
if FileName <> NormPath(CurrentPath) then
|
||||||
|
TestFailed(147);
|
||||||
|
if CurrentKey = 0 then
|
||||||
|
TestFailed(148);
|
||||||
|
WriteInteger('', 'Item5', 5);
|
||||||
|
WriteInteger('5', 'Item6', 6);
|
||||||
|
if ReadInteger('', 'Item5', 0) <> 5 then
|
||||||
|
TestFailed(150);
|
||||||
|
if ReadInteger('5', 'Item6', 0) <> 6 then
|
||||||
|
TestFailed(160);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
rini:=TRegistryIniFile.Create(STestRegPath);
|
rini:=TRegistryIniFile.Create(STestRegPath);
|
||||||
with rini do
|
with rini do
|
||||||
try
|
try
|
||||||
if ReadString('', 'Item1', '') <> '1' then
|
if ReadString('', 'Item1', '') <> '1' then
|
||||||
TestFailed(20);
|
TestFailed(201);
|
||||||
|
{ \ is not allowed as a section name }
|
||||||
|
if ReadString('\', 'Item1', '') = '1' then
|
||||||
|
TestFailed(202);
|
||||||
if ReadString('1', 'Item2', '') <> '2' then
|
if ReadString('1', 'Item2', '') <> '2' then
|
||||||
TestFailed(21);
|
TestFailed(205);
|
||||||
|
{ Trailing \ is allowed }
|
||||||
|
if ReadString('1\', 'Item2', '') <> '2' then
|
||||||
|
TestFailed(206);
|
||||||
if ReadString('', 'Item1', '') <> '1' then
|
if ReadString('', 'Item1', '') <> '1' then
|
||||||
TestFailed(22);
|
TestFailed(210);
|
||||||
if not ValueExists('', 'Item4') then
|
if not ValueExists('', 'Item4') then
|
||||||
TestFailed(23);
|
TestFailed(215);
|
||||||
if not ValueExists('1', 'Item2') then
|
if not ValueExists('1', 'Item2') then
|
||||||
TestFailed(24);
|
TestFailed(220);
|
||||||
|
if ReadInteger('2\3\4\5', 'Item6', 0) <> 6 then
|
||||||
|
TestFailed(225);
|
||||||
|
if ReadInteger('2\3\4', 'Item5', 0) <> 5 then
|
||||||
|
TestFailed(230);
|
||||||
|
|
||||||
|
EraseSection('2');
|
||||||
|
if SectionExists('2\3') then
|
||||||
|
TestFailed(245);
|
||||||
|
if ValueExists('2\3\4', 'Item5') then
|
||||||
|
TestFailed(240);
|
||||||
|
|
||||||
|
WriteString('2\3\4', 'Item10', '10');
|
||||||
|
if ReadInteger('2\3\4', 'Item10', 0) <> 10 then
|
||||||
|
TestFailed(245);
|
||||||
|
|
||||||
|
{ Check access via a full path }
|
||||||
|
if not SectionExists('\' + STestRegPath) then
|
||||||
|
TestFailed(250);
|
||||||
|
if ReadInteger('\2\3\4', 'Item10', 0) = 10 then
|
||||||
|
TestFailed(255);
|
||||||
|
if ReadInteger('\' + STestRegPath + '\2\3\4', 'Item10', 0) <> 10 then
|
||||||
|
TestFailed(260);
|
||||||
finally
|
finally
|
||||||
Free;
|
Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
finally
|
finally
|
||||||
reg.Free;
|
|
||||||
ClearReg;
|
ClearReg;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ Test if all test keys have been deleted by ClearReg() }
|
||||||
|
reg:=TRegistry.Create;
|
||||||
|
try
|
||||||
|
if reg.KeyExists(STestRegPath) then
|
||||||
|
TestFailed(501);
|
||||||
|
if reg.OpenKey(STestRegPath, False) then
|
||||||
|
TestFailed(502);
|
||||||
|
if reg.OpenKey(STestRegPath + '\2', False) then
|
||||||
|
TestFailed(503);
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user