* Patch from Bart Broersma to fix bug ID #36809 - test program

git-svn-id: trunk@44478 -

.gitattributes

@@ -16464,6 +16464,7 @@ tests/webtbf/uw8738b.pas svneol=native#text/plain
 tests/webtbs/Integer.ns.pp svneol=native#text/pascal
 tests/webtbs/Integer.pp svneol=native#text/pascal
 tests/webtbs/tu2002.pp svneol=native#text/plain
+tests/webtbs/tw0035022.pp svneol=native#text/plain
 tests/webtbs/tw0555.pp svneol=native#text/plain
 tests/webtbs/tw0630.pp svneol=native#text/plain
 tests/webtbs/tw0701a.pp svneol=native#text/plain

tests/webtbs/tw0035022.pp

@@ -0,0 +1,187 @@
+{ %TARGET=win32,win64,wince }
+
+program tw0035022;
+
+{$apptype console}
+{$mode objfpc}{$h+}
+{$ASSERTIONS ON}
+
+uses
+    registry, sysutils, classes;
+
+const
+  ROOT = 'Software';
+  subFPCREGINITEST = 'FreePascalRegIniTest';
+  subRegIni = 'RegIni';
+  subStrings = 'FPCTESTString';
+  fqFREEPASCALREGINITEST = Root + '\'+ subFPCREGINITEST;
+  fqFPCTESTRegIni = fqFREEPASCALREGINITEST + '\' + subRegIni;
+  fqFPCTESTStrings = fqFPCTESTRegIni+'\' + subStrings;
+  fqWrongFPCTESTStrings = Root + '\' + subStrings;
+  idString1 = 'String1';
+  valValue1 = 'Value1';
+
+procedure CheckCreate;
+var
+  Reg: TRegistry;
+  S, SKey: String;
+  B: Boolean;
+begin
+  write('CheckCreate: ');
+  Reg := TRegistry.Create(KEY_READ);
+  try
+    Reg.RootKey := HKEY_CURRENT_USER;
+    SKey := fqFPCTESTRegIni;
+    B := Reg.OpenKeyReadOnly(SKey);
+    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[SKey]));
+
+    SKey := subStrings;
+    B := Reg.OpenKeyReadOnly(Skey);
+    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[fqFPCTESTStrings]));
+
+    S := Reg.ReadString(idString1);
+    Assert(S=valValue1,format('ReadString(''%s''): expected '+'%s, but found: ''%s''',[idString1,valValue1,S]));
+
+    Reg.CloseKey;
+
+    writeln('OK');
+  finally
+    Reg.Free;
+  end;
+
+end;
+
+procedure FindErroneousEntries;
+var
+  Reg: TRegistry;
+  B: Boolean;
+begin
+  write('FindErroneousEntries: ');
+  Reg := TRegistry.Create(KEY_READ);
+  try
+    B := Reg.OpenKeyReadOnly(fqWrongFPCTESTStrings);
+    Reg.CloseKey;
+    Assert(not B, format('RegOpenKeyReadOnly found %s, which at this point is unexpected.',[fqWrongFPCTESTStrings]));
+    writeln(' no erroneous entries found (OK).');
+  finally
+    Reg.Free;
+  end;
+end;
+
+procedure CreateTestEntries;
+var
+  RegIni: TRegIniFile;
+  B: Boolean;
+  function TryOpenKey(Key: String; CanCreate: Boolean): Boolean;
+  begin
+    Result := RegIni.OpenKey(Key, CanCreate);
+  end;
+
+  function TryWriteString(Section, Ident, Value: String): Boolean;
+  begin
+    Result := False;
+    try
+      RegIni.WriteString(Section, Ident, Value);
+      Result := True;
+    except
+      on E: Exception do
+    end;
+  end;
+
+begin
+  write('CreateTestEntries: ');
+  RegIni := TRegIniFile.Create(Root);
+  try
+    Assert(RegIni.CurrentPath=Root,'Expected: CurrenPath='+Root);
+    B := RegIni.CreateKey(subFPCREGINITEST);
+    Assert(B,format('Error: CreateKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));
+
+    B := TryOpenKey(subFPCREGINITEST,False);
+    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));
+
+    Assert(RegIni.CurrentPath=fqFREEPASCALREGINITEST,'Expected: CurrenPath='+fqFREEPASCALREGINITEST);
+
+    B := TryOpenKey(subRegIni,True);
+    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFPCTESTRegIni]));
+    Assert(RegIni.CurrentPath=fqFPCTESTRegIni,'Expected: CurrenPath='+fqFPCTESTRegIni);
+
+    B := TryWriteString(subStrings,idString1,valValue1);
+    Assert(B,format('Error: WriteString(''%s'',''%s'',''%s'') failed.',[fqFPCTESTStrings,idString1,valValue1]));
+
+    writeln('OK');
+  finally
+    RegIni.Free;
+  end;
+
+end;
+
+procedure DeleteFPCTESTEntries;
+  procedure DeleteStrings;
+  var
+    Reg: TRegistry;
+    B: Boolean;
+  begin
+    Reg := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      Reg.RootKey := HKEY_CURRENT_USER;
+      if Reg.KeyExists(fqFPCTESTStrings) then
+      begin
+        B := Reg.OpenKey(fqFPCTESTStrings, False);
+        //writeln('OpenKey: ',B);
+        if B then
+        begin
+          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
+          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqFPCTESTStrings]));
+        end;
+        Reg.CloseKey;
+      end;
+
+      if Reg.KeyExists(fqWrongFPCTESTStrings) then
+      begin
+        B := Reg.OpenKey(fqWrongFPCTESTStrings, False);
+        //writeln('OpenKey: ',B);
+        if B then
+        begin
+          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
+          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqWrongFPCTESTStrings]));
+        end;
+        Reg.CloseKey;
+      end;
+    finally
+      Reg.Free;
+    end;
+  end;
+
+  procedure DeleteEmptyKey(Key: String);
+  var
+    Reg: TRegistry;
+    B: Boolean;
+  begin
+    Reg := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      Reg.RootKey := HKEY_CURRENT_USER;
+      if Reg.KeyExists(Key) then
+      begin
+        B := Reg.DeleteKey(Key);
+        Assert(B, format('Error DeleteKey(''%s'')',[Key]));
+      end;
+    finally
+      Reg.Free;
+    end;
+  end;
+
+begin
+  DeleteStrings;
+  DeleteEmptyKey(fqFPCTESTStrings);
+  DeleteEmptyKey(fqWrongFPCTESTStrings);
+  DeleteEmptyKey(fqFPCTESTRegIni);
+  DeleteEmptyKey(fqFREEPASCALREGINITEST);
+end;
+
+begin
+  DeleteFPCTESTEntries;
+  CreateTestEntries;
+  CheckCreate;
+  FindErroneousEntries;
+  DeleteFPCTESTEntries;
+end.