All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0036842FPCFCLpublic2020-03-29 14:022020-11-13 22:08
ReporterEric Heijnen Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Platformx86_64OSMac OSX 
Product Version3.3.1 
Fixed in 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 Revision47411
FPCOldBugId
FPCTarget3.2.2
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)   

Michael Van Canneyt

2020-11-13 22:01

administrator   ~0126895

Applied patch, verified test. Thanks for the report and the patch !

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
2020-11-13 22:01 Michael Van Canneyt Assigned To => Michael Van Canneyt
2020-11-13 22:01 Michael Van Canneyt Status new => resolved
2020-11-13 22:01 Michael Van Canneyt Resolution open => fixed
2020-11-13 22:01 Michael Van Canneyt Fixed in Revision => 47411
2020-11-13 22:01 Michael Van Canneyt FPCTarget => -
2020-11-13 22:01 Michael Van Canneyt Note Added: 0126895
2020-11-13 22:02 Michael Van Canneyt Fixed in Version => 3.3.1
2020-11-13 22:02 Michael Van Canneyt FPCTarget - => 3.2.2