View Issue Details

IDProjectCategoryView StatusLast Update
0036842FPCFCLpublic2020-05-19 22:26
ReporterEric Heijnen Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Platformx86_64OSMac OSX 
Product Version3.3.1 
Summary0036842: TRegistry writes to wrong Key when not in Windows
DescriptionWhen opening more than one TRegistry in a process with each a different opened key, writing and reading goes to the last opened key on each TRegistry object
Steps To ReproduceAttached an example process. On windows this works fine, on MacOSX it fails
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Eric Heijnen

2020-03-29 14:02

reporter  

Archive.zip (1,372 bytes)

Eric Heijnen

2020-03-29 14:55

reporter   ~0121750

(typo in the example, the 'should be 2' should be 'should be 3' obviously, but you'll see when you execute it)

Bart Broersma

2020-04-13 13:14

reporter   ~0122115

I can confirm this behaviour.

mgr.inz.Player

2020-05-18 20:53

reporter   ~0122913

I don't have MacOS, I tried to simulate it. I think it can be fixed with below patch for recent fcl-registry from trunk. I tried Eric's test and it passed.
xregreg.inc.patch (5,776 bytes)   
Index: xregreg.inc
===================================================================
--- xregreg.inc	(wersja 45411)
+++ xregreg.inc	(kopia robocza)
@@ -39,6 +39,22 @@
   end;
 end;
 
+Function RootKeyToRootKeyStr(Value: HKEY): UnicodeString;
+
+begin
+  Case Value of
+    HKEY_CLASSES_ROOT     : Result := 'HKEY_CLASSES_ROOT';
+    HKEY_CURRENT_USER     : Result := 'HKEY_CURRENT_USER';
+    HKEY_LOCAL_MACHINE    : Result := 'HKEY_LOCAL_MACHINE';
+    HKEY_USERS            : Result := 'HKEY_USERS';
+    HKEY_PERFORMANCE_DATA : Result := 'HKEY_PERFORMANCE_DATA';
+    HKEY_CURRENT_CONFIG   : Result := 'HKEY_CURRENT_CONFIG';
+    HKEY_DYN_DATA         : Result := 'HKEY_DYN_DATA';
+  else
+    Result:=Format('Key%d',[Value]);
+  end;
+end;
+
 type
 
   { TXMLRegistryInstance }
@@ -115,6 +131,26 @@
   Dec(FRefCount);
 end;
 
+procedure useKeyFromTRegistryInstance(reg: TRegistry);
+var XmlRegistry: TXMLRegistry;
+    RootKeyStr: UnicodeString;
+begin
+  XmlRegistry:=TXMLRegistry(reg.FSysData);
+  RootKeyStr:=RootKeyToRootKeyStr(reg.RootKey);
+
+  // '/' at the end when comparing
+  if (reg.CurrentKey=0) and (XmlRegistry.RootKey <> (RootKeyStr + '/')) then
+    XmlRegistry.SetRootKey(RootKeyStr)
+  else
+    begin
+    if XmlRegistry.CurrentKey <> (RootKeyStr+'/'+reg.CurrentPath + '/') then
+      begin
+      XmlRegistry.SetRootKey(RootKeyStr);
+      XmlRegistry.SetKey(reg.CurrentPath, false);
+      end;
+    end;
+end;
+
 procedure TRegistry.SysRegCreate;
 var s : string;
 begin
@@ -139,6 +175,7 @@
 function TRegistry.SysCreateKey(Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
 end;
 
@@ -145,11 +182,13 @@
 function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
 end;
 
 function TRegistry.DeleteValue(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
 end;
 
@@ -159,6 +198,7 @@
 Var
   DataType : TDataType;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=BufSize;
   If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
     RegData:=DataTypeToRegDataType(DataType)
@@ -172,6 +212,7 @@
   Info : TDataInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True);
   If Not Result then
     With Value do
@@ -198,6 +239,7 @@
   Info : TKeyInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).GetKeyInfo(info);
   If Result then
     With Value,Info do
@@ -213,6 +255,7 @@
 
 function TRegistry.KeyExists(const Key: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).KeyExists(Key);
 end;
 
@@ -227,9 +270,10 @@
   S: UnicodeString;
   P: SizeInt;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
-  FCurrentKey:=1;
   If Result then begin
+    fCurrentKey:=1;
     S:=TXmlRegistry(FSysData).CurrentKey;
     if (S>'') then begin
       //S starts with RootKey+'/'
@@ -237,7 +281,7 @@
       if (P>0) then
         System.Delete(S,1,P);
     end;
-    ChangeKey(FCurrentKey, S);
+    ChangeKey(fCurrentKey, S);
   end;
 end;
 
@@ -244,7 +288,7 @@
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
 
 begin
-  Result:=TXmlRegistry(FSysData).SetKey(Key,False);
+  Result:=OpenKey(Key,False);
 end;
 
 function TRegistry.RegistryConnect(const UNCName: UnicodeString): Boolean;
@@ -274,6 +318,7 @@
 
 function TRegistry.ValueExists(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).ValueExists(Name);
 end;
 
@@ -284,11 +329,13 @@
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).EnumSubKeys;
 end;
 
 function TRegistry.GetValueNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).EnumValues;
 end;
 
@@ -300,6 +347,7 @@
   DataType : TDataType;
 
 begin
+  useKeyFromTRegistryInstance(self);
   //writeln('TRegistry.SysPutData: Name=',Name,', RegData=',RegData,', BufSize=',BufSize);
   DataType:=RegDataTypeToXmlDataType(RegData);
 
@@ -308,6 +356,7 @@
 
 procedure TRegistry.RenameValue(const OldName, NewName: UnicodeString);
 begin
+  useKeyFromTRegistryInstance(self);
   TXMLRegistry(FSysData).RenameValue(OldName,NewName);
 end;
 
@@ -323,24 +372,11 @@
   S: UnicodeString;
 
 begin
-  If (Value=HKEY_CLASSES_ROOT) then
-    S:='HKEY_CLASSES_ROOT'
-  else if (Value=HKEY_CURRENT_USER) then
-    S:='HKEY_CURRENT_USER'
-  else if (Value=HKEY_LOCAL_MACHINE) then
-    S:='HKEY_LOCAL_MACHINE'
-  else if (Value=HKEY_USERS) then
-    S:='HKEY_USERS'
-  else if Value=HKEY_PERFORMANCE_DATA then
-    S:='HKEY_PERFORMANCE_DATA'
-  else if (Value=HKEY_CURRENT_CONFIG) then
-    S:='HKEY_CURRENT_CONFIG'
-  else if (Value=HKEY_DYN_DATA) then
-    S:='HKEY_DYN_DATA'
-  else
-    S:=Format('Key%d',[Value]);
+  S:=RootKeyToRootKeyStr(Value);
   TXmlRegistry(FSysData).SetRootKey(S);
   fRootKey := Value;
+  fCurrentKey:=0;
+  FCurrentPath:='';
 end;
 
 function TRegistry.GetLastErrorMsg: string;
@@ -357,6 +393,8 @@
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;
 
@@ -367,6 +405,8 @@
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;
 
xregreg.inc.patch (5,776 bytes)   

mgr.inz.Player

2020-05-19 22:26

reporter   ~0122944

I should have used UnicodeCompareText
xregreg.inc.2.patch (5,814 bytes)   
Index: xregreg.inc
===================================================================
--- xregreg.inc	(wersja 45411)
+++ xregreg.inc	(kopia robocza)
@@ -39,6 +39,22 @@
   end;
 end;
 
+Function RootKeyToRootKeyStr(Value: HKEY): UnicodeString;
+
+begin
+  Case Value of
+    HKEY_CLASSES_ROOT     : Result := 'HKEY_CLASSES_ROOT';
+    HKEY_CURRENT_USER     : Result := 'HKEY_CURRENT_USER';
+    HKEY_LOCAL_MACHINE    : Result := 'HKEY_LOCAL_MACHINE';
+    HKEY_USERS            : Result := 'HKEY_USERS';
+    HKEY_PERFORMANCE_DATA : Result := 'HKEY_PERFORMANCE_DATA';
+    HKEY_CURRENT_CONFIG   : Result := 'HKEY_CURRENT_CONFIG';
+    HKEY_DYN_DATA         : Result := 'HKEY_DYN_DATA';
+  else
+    Result:=Format('Key%d',[Value]);
+  end;
+end;
+
 type
 
   { TXMLRegistryInstance }
@@ -115,6 +131,26 @@
   Dec(FRefCount);
 end;
 
+procedure useKeyFromTRegistryInstance(reg: TRegistry);
+var XmlRegistry: TXMLRegistry;
+    RootKeyStr: UnicodeString;
+begin
+  XmlRegistry:=TXMLRegistry(reg.FSysData);
+  RootKeyStr:=RootKeyToRootKeyStr(reg.RootKey);
+
+  // '/' at the end when comparing
+  if (reg.CurrentKey=0) and (UnicodeCompareText(XmlRegistry.RootKey, RootKeyStr + '/')<>0) then
+    XmlRegistry.SetRootKey(RootKeyStr)
+  else
+    begin
+    if UnicodeCompareText(XmlRegistry.CurrentKey, RootKeyStr+'/'+reg.CurrentPath + '/')<>0 then
+      begin
+      XmlRegistry.SetRootKey(RootKeyStr);
+      XmlRegistry.SetKey(reg.CurrentPath, false);
+      end;
+    end;
+end;
+
 procedure TRegistry.SysRegCreate;
 var s : string;
 begin
@@ -139,6 +175,7 @@
 function TRegistry.SysCreateKey(Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
 end;
 
@@ -145,11 +182,13 @@
 function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
 end;
 
 function TRegistry.DeleteValue(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
 end;
 
@@ -159,6 +198,7 @@
 Var
   DataType : TDataType;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=BufSize;
   If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
     RegData:=DataTypeToRegDataType(DataType)
@@ -172,6 +212,7 @@
   Info : TDataInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True);
   If Not Result then
     With Value do
@@ -198,6 +239,7 @@
   Info : TKeyInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).GetKeyInfo(info);
   If Result then
     With Value,Info do
@@ -213,6 +255,7 @@
 
 function TRegistry.KeyExists(const Key: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).KeyExists(Key);
 end;
 
@@ -227,9 +270,10 @@
   S: UnicodeString;
   P: SizeInt;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
-  FCurrentKey:=1;
   If Result then begin
+    fCurrentKey:=1;
     S:=TXmlRegistry(FSysData).CurrentKey;
     if (S>'') then begin
       //S starts with RootKey+'/'
@@ -237,7 +281,7 @@
       if (P>0) then
         System.Delete(S,1,P);
     end;
-    ChangeKey(FCurrentKey, S);
+    ChangeKey(fCurrentKey, S);
   end;
 end;
 
@@ -244,7 +288,7 @@
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
 
 begin
-  Result:=TXmlRegistry(FSysData).SetKey(Key,False);
+  Result:=OpenKey(Key,False);
 end;
 
 function TRegistry.RegistryConnect(const UNCName: UnicodeString): Boolean;
@@ -274,6 +318,7 @@
 
 function TRegistry.ValueExists(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).ValueExists(Name);
 end;
 
@@ -284,11 +329,13 @@
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).EnumSubKeys;
 end;
 
 function TRegistry.GetValueNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).EnumValues;
 end;
 
@@ -300,6 +347,7 @@
   DataType : TDataType;
 
 begin
+  useKeyFromTRegistryInstance(self);
   //writeln('TRegistry.SysPutData: Name=',Name,', RegData=',RegData,', BufSize=',BufSize);
   DataType:=RegDataTypeToXmlDataType(RegData);
 
@@ -308,6 +356,7 @@
 
 procedure TRegistry.RenameValue(const OldName, NewName: UnicodeString);
 begin
+  useKeyFromTRegistryInstance(self);
   TXMLRegistry(FSysData).RenameValue(OldName,NewName);
 end;
 
@@ -323,24 +372,11 @@
   S: UnicodeString;
 
 begin
-  If (Value=HKEY_CLASSES_ROOT) then
-    S:='HKEY_CLASSES_ROOT'
-  else if (Value=HKEY_CURRENT_USER) then
-    S:='HKEY_CURRENT_USER'
-  else if (Value=HKEY_LOCAL_MACHINE) then
-    S:='HKEY_LOCAL_MACHINE'
-  else if (Value=HKEY_USERS) then
-    S:='HKEY_USERS'
-  else if Value=HKEY_PERFORMANCE_DATA then
-    S:='HKEY_PERFORMANCE_DATA'
-  else if (Value=HKEY_CURRENT_CONFIG) then
-    S:='HKEY_CURRENT_CONFIG'
-  else if (Value=HKEY_DYN_DATA) then
-    S:='HKEY_DYN_DATA'
-  else
-    S:=Format('Key%d',[Value]);
+  S:=RootKeyToRootKeyStr(Value);
   TXmlRegistry(FSysData).SetRootKey(S);
   fRootKey := Value;
+  fCurrentKey:=0;
+  FCurrentPath:='';
 end;
 
 function TRegistry.GetLastErrorMsg: string;
@@ -357,6 +393,8 @@
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;
 
@@ -367,6 +405,8 @@
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;
 
xregreg.inc.2.patch (5,814 bytes)   

Issue History

Date Modified Username Field Change
2020-03-29 14:02 Eric Heijnen New Issue
2020-03-29 14:02 Eric Heijnen File Added: Archive.zip
2020-03-29 14:55 Eric Heijnen Note Added: 0121750
2020-04-13 13:14 Bart Broersma Note Added: 0122115
2020-05-18 20:53 mgr.inz.Player Note Added: 0122913
2020-05-18 20:53 mgr.inz.Player File Added: xregreg.inc.patch
2020-05-19 22:26 mgr.inz.Player Note Added: 0122944
2020-05-19 22:26 mgr.inz.Player File Added: xregreg.inc.2.patch