mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 02:19:40 +02:00
* Extended the tregistry2 test.
git-svn-id: trunk@48203 -
This commit is contained in:
yury
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}
|
||||
unit tregistry2;
|
||||
|
||||
@ -9,6 +14,11 @@ implementation
|
||||
|
||||
uses Windows, SysUtils, Classes, registry;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$WARN implicit_string_cast_loss off}
|
||||
{$WARN symbol_deprecated off}
|
||||
{$endif FPC}
|
||||
|
||||
const
|
||||
STestRegPath = 'Software\FPC-RegTest';
|
||||
|
||||
@ -17,17 +27,21 @@ begin
|
||||
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
|
||||
end;
|
||||
|
||||
procedure ClearReg;
|
||||
procedure ClearReg(const KeyName: string = '');
|
||||
begin
|
||||
with TRegistry.Create do
|
||||
try
|
||||
DeleteKey(STestRegPath + '\1');
|
||||
DeleteKey(STestRegPath);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function NormPath(const s: string): string;
|
||||
begin
|
||||
Result:=StringReplace(s, '/', '\', [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
procedure DoRegTest2;
|
||||
var
|
||||
reg: TRegistry;
|
||||
@ -36,33 +50,47 @@ var
|
||||
sl: TStringList;
|
||||
begin
|
||||
ClearReg;
|
||||
reg:=TRegistry.Create;
|
||||
try
|
||||
if not reg.OpenKey(STestRegPath, True) then
|
||||
TestFailed(1);
|
||||
if reg.CurrentPath <> STestRegPath then
|
||||
TestFailed(2);
|
||||
reg.WriteString('Item1', '1');
|
||||
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
|
||||
TestFailed(3);
|
||||
reg.WriteString('Item2', '2');
|
||||
if reg.CurrentPath <> STestRegPath + '\1' then
|
||||
TestFailed(5);
|
||||
reg.CloseKey;
|
||||
if reg.CurrentPath <> '' then
|
||||
TestFailed(6);
|
||||
reg:=TRegistry.Create;
|
||||
try
|
||||
{ The test key must be deleted by ClearReg() }
|
||||
if reg.KeyExists(STestRegPath) then
|
||||
TestFailed(1);
|
||||
if reg.OpenKey(STestRegPath, False) then
|
||||
TestFailed(2);
|
||||
|
||||
if not reg.OpenKey(STestRegPath, True) then
|
||||
TestFailed(5);
|
||||
if NormPath(reg.CurrentPath) <> STestRegPath then
|
||||
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);
|
||||
with ri do
|
||||
try
|
||||
if ReadString('', 'Item1', '') <> '1' then
|
||||
TestFailed(10);
|
||||
TestFailed(101);
|
||||
if ReadString('1', 'Item2', '') <> '2' then
|
||||
TestFailed(11);
|
||||
TestFailed(105);
|
||||
if NormPath(ri.CurrentPath) <> STestRegPath then
|
||||
TestFailed(110);
|
||||
if ReadString('', 'Item1', '') <> '1' then
|
||||
TestFailed(12);
|
||||
TestFailed(115);
|
||||
if not ValueExists('Item1') then
|
||||
TestFailed(13);
|
||||
TestFailed(120);
|
||||
|
||||
WriteInteger('1', 'Item3', 3);
|
||||
|
||||
@ -70,43 +98,118 @@ begin
|
||||
try
|
||||
ReadSectionValues('1', sl);
|
||||
if sl.Count <> 2 then
|
||||
TestFailed(14);
|
||||
TestFailed(125);
|
||||
if sl.Values['Item2'] <> '2' then
|
||||
TestFailed(15);
|
||||
TestFailed(130);
|
||||
if sl.Values['Item3'] <> '3' then
|
||||
TestFailed(16);
|
||||
TestFailed(135);
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
|
||||
WriteInteger('', 'Item4', 4);
|
||||
if GetDataType('Item4') <> rdString then
|
||||
TestFailed(17);
|
||||
WriteInteger('', 'Item41', 41);
|
||||
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
|
||||
Free;
|
||||
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);
|
||||
with rini do
|
||||
try
|
||||
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
|
||||
TestFailed(21);
|
||||
TestFailed(205);
|
||||
{ Trailing \ is allowed }
|
||||
if ReadString('1\', 'Item2', '') <> '2' then
|
||||
TestFailed(206);
|
||||
if ReadString('', 'Item1', '') <> '1' then
|
||||
TestFailed(22);
|
||||
TestFailed(210);
|
||||
if not ValueExists('', 'Item4') then
|
||||
TestFailed(23);
|
||||
TestFailed(215);
|
||||
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
|
||||
Free;
|
||||
end;
|
||||
|
||||
finally
|
||||
reg.Free;
|
||||
ClearReg;
|
||||
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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user