* Moved the tregistry2.pp test from packages to tests in order it to be run by daily test runs. tregistry2 has been failing for years and nobody has noticed this.

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48204 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 210 insertions, 0 deletions

diff --git a/tests/test/packages/fcl-registry/tregistry2.pp b/tests/test/packages/fcl-registry/tregistry2.pp
new file mode 100644
index 0000000000..db9c13ee2f
--- /dev/null
+++ b/tests/test/packages/fcl-registry/tregistry2.pp
@@ -0,0 +1,210 @@
+{
+  This unit tests mostly TRegIniFile to work properly and be Delphi compatible.
+  Please keep this unit Delphi compatible.
+}
+
+{$ifdef FPC} {$mode delphi}  {$endif}
+uses Windows, SysUtils, Classes, registry;
+
+{$ifdef FPC}
+  {$WARN implicit_string_cast_loss off}
+  {$WARN symbol_deprecated off}
+{$endif FPC}
+
+const
+  STestRegPath = 'Software\FPC-RegTest';
+  
+procedure TestFailed(ErrCode: integer);
+begin
+  writeln('Test FAILED. Error code: ' + IntToStr(ErrCode));
+  Halt(ErrCode);
+end;
+
+procedure ClearReg(const KeyName: string = '');
+begin
+  with TRegistry.Create do
+    try
+      DeleteKey(STestRegPath);
+    finally
+      Free;
+    end;
+end;
+
+function NormPath(const s: string): string;
+begin
+  Result:=StringReplace(s, '/', '\', [rfReplaceAll]);
+end;
+
+procedure DoRegTest2;
+var
+  reg: TRegistry;
+  ri: TRegIniFile;
+  rini: TRegistryIniFile;
+  sl: TStringList;
+begin
+  ClearReg;
+  try
+    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(101);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(105);
+      if NormPath(ri.CurrentPath) <> STestRegPath then
+        TestFailed(110);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(115);
+      if not ValueExists('Item1') then
+        TestFailed(120);
+
+      WriteInteger('1', 'Item3', 3);
+
+      sl:=TStringList.Create;
+      try
+        ReadSectionValues('1', sl);
+        if sl.Count <> 2 then
+          TestFailed(125);
+        if sl.Values['Item2'] <> '2' then
+          TestFailed(130);
+        if sl.Values['Item3'] <> '3' then
+          TestFailed(135);
+      finally
+        sl.Free;
+      end;
+
+      WriteInteger('', 'Item4', 4);
+      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(201);
+      { \ is not allowed as a section name }
+      if ReadString('\', 'Item1', '') = '1' then
+        TestFailed(202);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(205);
+      { Trailing \ is allowed }
+      if ReadString('1\', 'Item2', '') <> '2' then
+        TestFailed(206);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(210);
+      if not ValueExists('', 'Item4') then
+        TestFailed(215);
+      if not ValueExists('1', 'Item2') then
+        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
+    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;
+
+begin
+  DoRegTest2;
+end.