fpc/packages/fcl-registry/tests/tregistry2.pp
yury 25602c7cbd * Make TRegIniFile Delphi compatible.
* Fix completely broken TRegistryIniFile.
+ Tests.

git-svn-id: trunk@22654 -
2012-10-15 12:43:14 +00:00

114 lines
2.4 KiB
ObjectPascal

{$ifdef FPC} {$mode delphi} {$endif}
unit tregistry2;
interface
procedure DoRegTest2;
implementation
uses Windows, SysUtils, Classes, registry;
const
STestRegPath = 'Software\FPC-RegTest';
procedure TestFailed(ErrCode: integer);
begin
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
end;
procedure ClearReg;
begin
with TRegistry.Create do
try
DeleteKey(STestRegPath + '\1');
DeleteKey(STestRegPath);
finally
Free;
end;
end;
procedure DoRegTest2;
var
reg: TRegistry;
ri: TRegIniFile;
rini: TRegistryIniFile;
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);
ri:=TRegIniFile.Create(STestRegPath);
with ri do
try
if ReadString('', 'Item1', '') <> '1' then
TestFailed(10);
if ReadString('1', 'Item2', '') <> '2' then
TestFailed(11);
if ReadString('', 'Item1', '') <> '1' then
TestFailed(12);
if not ValueExists('Item1') then
TestFailed(13);
WriteInteger('1', 'Item3', 3);
sl:=TStringList.Create;
try
ReadSectionValues('1', sl);
if sl.Count <> 2 then
TestFailed(14);
if sl.Values['Item2'] <> '2' then
TestFailed(15);
if sl.Values['Item3'] <> '3' then
TestFailed(16);
finally
sl.Free;
end;
WriteInteger('', 'Item4', 4);
if GetDataType('Item4') <> rdString then
TestFailed(17);
finally
Free;
end;
rini:=TRegistryIniFile.Create(STestRegPath);
with rini do
try
if ReadString('', 'Item1', '') <> '1' then
TestFailed(20);
if ReadString('1', 'Item2', '') <> '2' then
TestFailed(21);
if ReadString('', 'Item1', '') <> '1' then
TestFailed(22);
if not ValueExists('', 'Item4') then
TestFailed(23);
if not ValueExists('1', 'Item2') then
TestFailed(24);
finally
Free;
end;
finally
reg.Free;
ClearReg;
end;
end;
end.