+ Added tests for TRegistry bugs.

git-svn-id: trunk@22650 -

.gitattributes

@@ -2389,6 +2389,7 @@ packages/fcl-registry/tests/Makefile svneol=native#text/plain
 packages/fcl-registry/tests/Makefile.fpc -text
 packages/fcl-registry/tests/regtestframework.pp -text
 packages/fcl-registry/tests/testbasics.pp svneol=native#text/plain
+packages/fcl-registry/tests/tregistry2.pp svneol=native#text/plain
 packages/fcl-res/Makefile svneol=native#text/plain
 packages/fcl-res/Makefile.fpc svneol=native#text/plain
 packages/fcl-res/Makefile.fpc.fpcmake svneol=native#text/plain

packages/fcl-registry/tests/testbasics.pp

@@ -22,12 +22,17 @@ type
     procedure TestSimpleWinRegistry;
     procedure TestDoubleWrite;
     procedure bug16395;
+    procedure TestAdv;
   end;
 
 implementation
 
 uses
-  registry;
+  registry
+{$ifdef windows}
+  , tregistry2
+{$endif windows}
+  ;
 
 { TTestBasics }
 
@@ -140,6 +145,13 @@ begin
   DeleteUserXmlFile;
 end;
 
+procedure TTestBasics.TestAdv;
+begin
+{$ifdef windows}
+  DoRegTest2;
+{$endif windows}
+end;
+
 initialization
   RegisterTest(TTestBasics);
 end.

packages/fcl-registry/tests/tregistry2.pp

@@ -0,0 +1,44 @@
+{$ifdef FPC} {$mode delphi}  {$endif}
+unit tregistry2;
+
+interface
+
+procedure DoRegTest2;
+
+implementation
+
+uses Windows, SysUtils, registry;
+
+const
+  STestRegPath = 'Software\FPC-RegTest';
+  
+procedure TestFailed(ErrCode: integer);
+begin
+  raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
+end;
+
+procedure DoRegTest2;
+var
+  reg: TRegistry;
+  k: HKEY;
+begin
+  reg:=TRegistry.Create;
+  try
+    if not reg.OpenKey(STestRegPath, True) then
+      TestFailed(1);
+    if reg.CurrentPath <> STestRegPath then
+      TestFailed(2);
+    k:=reg.CurrentKey;
+    if not reg.OpenKey('\' + STestRegPath + '\1', True) then
+      TestFailed(3);
+    if RegCloseKey(k) = 0 then
+      TestFailed(4);
+    if reg.CurrentPath <> STestRegPath + '\1' then
+      TestFailed(5);
+  finally
+    reg.Free;
+  end;
+end;
+
+end.
+