* synchronize with trunk

git-svn-id: branches/z80@44503 -

.gitattributes

@@ -16499,6 +16499,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

compiler/options.pas

@@ -4248,8 +4248,7 @@ begin
      ((target_info.system in [system_arm_wince,system_arm_gba,
          system_m68k_amiga,system_m68k_atari,
          system_arm_nds,system_arm_embedded,
-         system_riscv32_embedded,system_riscv64_embedded,system_xtensa_embedded,
-         system_xtensa_freertos])
+         system_riscv32_embedded,system_riscv64_embedded,system_xtensa_embedded])
 {$ifdef arm}
       or (target_info.abi=abi_eabi)
 {$endif arm}
@@ -4284,6 +4283,11 @@ begin
   end;
 {$endif i386}
 
+{$ifdef xtensa}
+  if not(option.FPUSetExplicitly) then
+    init_settings.fputype:=embedded_controllers[init_settings.controllertype].fputype;
+{$endif xtensa}
+
 {$ifdef arm}
   case target_info.system of
     system_arm_darwin:

compiler/systems/i_freertos.pas

@@ -714,7 +714,7 @@ unit i_freertos;
             first_parm_offset : 8;
             stacksize    : 65536;
             stackalign   : 16;
-            abi : abi_default;
+            abi : abi_xtensa_windowed;
             llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32-S32';
           );
 

compiler/xtensa/cgcpu.pas

@@ -633,8 +633,11 @@ implementation
                     end
                   else
                     begin
-                      { spill area }
-                      inc(localsize,max(txtensaprocinfo(current_procinfo).maxcall,4)*4);
+                      { default spill area }
+                      inc(localsize,4*4);
+                      { additional spill area? }
+                      if pi_do_call in current_procinfo.flags then
+                        inc(localsize,txtensaprocinfo(current_procinfo).maxcall*4);
 
                       localsize:=align(localsize,current_settings.alignment.localalignmax);
                     end;

compiler/xtensa/cpupi.pas

@@ -65,7 +65,7 @@ unit cpupi;
     constructor txtensaprocinfo.create(aparent: tprocinfo);
       begin
         inherited create(aparent);
-        maxpushedparasize := 0;
+        maxpushedparasize:=0;
         if target_info.abi=abi_xtensa_windowed then
           begin
             callins:=A_CALL8;
@@ -92,23 +92,15 @@ unit cpupi;
         localsize : aint;
         i : longint;
       begin
-        if (po_nostackframe in procdef.procoptions) then
-          begin
-             { maxpushedparasize sghould be zero,
-               if not we will get an error later. }
-             tg.setfirsttemp(maxpushedparasize);
-             exit;
-          end;
+        tg.setfirsttemp(maxpushedparasize);
 
-        if tg.direction = -1 then
-          tg.setfirsttemp(-(1+12)*4)
-        else
-          tg.setfirsttemp(maxpushedparasize);
+        if po_nostackframe in procdef.procoptions then
+          exit;
 
         { estimate stack frame size }
         if pi_estimatestacksize in flags then
           begin
-            stackframesize:=maxpushedparasize+32;
+            stackframesize:=maxpushedparasize;
             localsize:=0;
             for i:=0 to procdef.localst.SymList.Count-1 do
               if tsym(procdef.localst.SymList[i]).typ=localvarsym then
@@ -126,7 +118,6 @@ unit cpupi;
                   else
                     inc(localsize,tabstractnormalvarsym(procdef.parast.SymList[i]).getsize);
                 end;
-
             inc(stackframesize,localsize);
 
             if pi_needs_implicit_finally in flags then

compiler/xtensa/rxtensacon.inc

@@ -16,19 +16,35 @@ NR_A12 = tregister($0100000c);
 NR_A13 = tregister($0100000d);
 NR_A14 = tregister($0100000e);
 NR_A15 = tregister($0100000f);
-NR_F0 = tregister($01000000);
-NR_F1 = tregister($01000001);
-NR_F2 = tregister($01000002);
-NR_F3 = tregister($01000003);
-NR_F4 = tregister($01000004);
-NR_F5 = tregister($01000005);
-NR_F6 = tregister($01000006);
-NR_F7 = tregister($01000007);
-NR_F8 = tregister($01000008);
-NR_F9 = tregister($01000009);
-NR_F10 = tregister($0100000f);
-NR_F11 = tregister($0100000b);
-NR_F12 = tregister($0100000c);
-NR_F13 = tregister($0100000d);
-NR_F14 = tregister($0100000e);
-NR_F15 = tregister($0100000f);
+NR_F0 = tregister($02000000);
+NR_F1 = tregister($02000001);
+NR_F2 = tregister($02000002);
+NR_F3 = tregister($02000003);
+NR_F4 = tregister($02000004);
+NR_F5 = tregister($02000005);
+NR_F6 = tregister($02000006);
+NR_F7 = tregister($02000007);
+NR_F8 = tregister($02000008);
+NR_F9 = tregister($02000009);
+NR_F10 = tregister($0200000f);
+NR_F11 = tregister($0200000b);
+NR_F12 = tregister($0200000c);
+NR_F13 = tregister($0200000d);
+NR_F14 = tregister($0200000e);
+NR_F15 = tregister($0200000f);
+NR_B0 = tregister($05000000);
+NR_B1 = tregister($05000001);
+NR_B2 = tregister($05000002);
+NR_B3 = tregister($05000003);
+NR_B4 = tregister($05000004);
+NR_B5 = tregister($05000005);
+NR_B6 = tregister($05000006);
+NR_B7 = tregister($05000007);
+NR_B8 = tregister($05000008);
+NR_B9 = tregister($05000009);
+NR_B10 = tregister($0500000b);
+NR_B11 = tregister($0500000b);
+NR_B12 = tregister($0500000c);
+NR_B13 = tregister($0500000d);
+NR_B14 = tregister($0500000e);
+NR_B15 = tregister($0500000b);

compiler/xtensa/rxtensadwa.inc

@@ -31,4 +31,20 @@
 12,
 13,
 14,
+15,
+0,
+1,
+2,
+3,
+4,
+5,
+6,
+7,
+8,
+9,
+10,
+11,
+12,
+13,
+14,
 15

compiler/xtensa/rxtensanor.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from xtensareg.dat }
-33
+49

compiler/xtensa/rxtensanum.inc

@@ -16,19 +16,35 @@ tregister($0100000c),
 tregister($0100000d),
 tregister($0100000e),
 tregister($0100000f),
-tregister($01000000),
-tregister($01000001),
-tregister($01000002),
-tregister($01000003),
-tregister($01000004),
-tregister($01000005),
-tregister($01000006),
-tregister($01000007),
-tregister($01000008),
-tregister($01000009),
-tregister($0100000f),
-tregister($0100000b),
-tregister($0100000c),
-tregister($0100000d),
-tregister($0100000e),
-tregister($0100000f)
+tregister($02000000),
+tregister($02000001),
+tregister($02000002),
+tregister($02000003),
+tregister($02000004),
+tregister($02000005),
+tregister($02000006),
+tregister($02000007),
+tregister($02000008),
+tregister($02000009),
+tregister($0200000f),
+tregister($0200000b),
+tregister($0200000c),
+tregister($0200000d),
+tregister($0200000e),
+tregister($0200000f),
+tregister($05000000),
+tregister($05000001),
+tregister($05000002),
+tregister($05000003),
+tregister($05000004),
+tregister($05000005),
+tregister($05000006),
+tregister($05000007),
+tregister($05000008),
+tregister($05000009),
+tregister($0500000b),
+tregister($0500000b),
+tregister($0500000c),
+tregister($0500000d),
+tregister($0500000e),
+tregister($0500000b)

compiler/xtensa/rxtensarni.inc

@@ -1,34 +1,50 @@
 { don't edit, this file is generated from xtensareg.dat }
 0,
 1,
-17,
 2,
-18,
 3,
-19,
 4,
-20,
 5,
-21,
 6,
-22,
 7,
-23,
 8,
-24,
 9,
-25,
 10,
-26,
 11,
 12,
-28,
 13,
-29,
 14,
-30,
 15,
-31,
 16,
+17,
+18,
+19,
+20,
+21,
+22,
+23,
+24,
+25,
+26,
+28,
+29,
+30,
+31,
 27,
-32
+32,
+33,
+34,
+35,
+36,
+37,
+38,
+39,
+40,
+41,
+42,
+43,
+44,
+48,
+45,
+46,
+47

compiler/xtensa/rxtensasri.inc

@@ -16,6 +16,22 @@
 8,
 9,
 10,
+33,
+34,
+43,
+44,
+45,
+46,
+47,
+48,
+35,
+36,
+37,
+38,
+39,
+40,
+41,
+42,
 17,
 18,
 27,

compiler/xtensa/rxtensasta.inc

@@ -31,4 +31,20 @@
 12,
 13,
 14,
+15,
+0,
+1,
+2,
+3,
+4,
+5,
+6,
+7,
+8,
+9,
+10,
+11,
+12,
+13,
+14,
 15

compiler/xtensa/rxtensastd.inc

@@ -31,4 +31,20 @@
 'f12',
 'f13',
 'f14',
-'f15'
+'f15',
+'b0',
+'b1',
+'b2',
+'b3',
+'b4',
+'b5',
+'b6',
+'b7',
+'b8',
+'b9',
+'b10',
+'b11',
+'b12',
+'b13',
+'b14',
+'b15'

compiler/xtensa/rxtensasup.inc

@@ -32,3 +32,19 @@ RS_F12 = $0c;
 RS_F13 = $0d;
 RS_F14 = $0e;
 RS_F15 = $0f;
+RS_B0 = $00;
+RS_B1 = $01;
+RS_B2 = $02;
+RS_B3 = $03;
+RS_B4 = $04;
+RS_B5 = $05;
+RS_B6 = $06;
+RS_B7 = $07;
+RS_B8 = $08;
+RS_B9 = $09;
+RS_B10 = $0b;
+RS_B11 = $0b;
+RS_B12 = $0c;
+RS_B13 = $0d;
+RS_B14 = $0e;
+RS_B15 = $0b;

compiler/xtensa/xtensaatt.inc

@@ -2,6 +2,7 @@
 'none',
 'abs',
 'add',
+'add.s',
 'addi',
 'addmi',
 'and',
@@ -28,9 +29,14 @@
 'mov.s',
 'movnez',
 'movi',
+'mul.s',
 'mull',
 'neg',
+'neg.s',
 'nop',
+'oeq.s',
+'ole.s',
+'olt.s',
 'or',
 'ret',
 'retw',
@@ -47,6 +53,7 @@
 'ssl',
 'ssr',
 'sub',
+'sub.s',
 'xor'
 );
 

compiler/xtensa/xtensaop.inc

@@ -2,6 +2,7 @@
 A_NONE,
 A_ABS,
 A_ADD,
+A_ADD_S,
 A_ADDI,
 A_ADDMI,
 A_AND,
@@ -28,9 +29,14 @@ A_MOV,
 A_MOV_S,
 A_MOVNEZ,
 A_MOVI,
+A_MUL_S,
 A_MULL,
 A_NEG,
+A_NEG_S,
 A_NOP,
+A_OEQ_S,
+A_OLE_S,
+A_OLT_S,
 A_OR,
 A_RET,
 A_RETW,
@@ -47,6 +53,7 @@ A_SSI,
 A_SSL,
 A_SSR,
 A_SUB,
+A_SUB_S,
 A_XOR
 );
 

compiler/xtensa/xtensareg.dat

@@ -24,22 +24,38 @@ A14,$01,$00,$0e,a14,14,14
 A15,$01,$00,$0f,a15,15,15
 
 ; Floating point registers
-F0,$01,$00,$00,f0,0,0
-F1,$01,$00,$01,f1,1,1
-F2,$01,$00,$02,f2,2,2
-F3,$01,$00,$03,f3,3,3
-F4,$01,$00,$04,f4,4,4
-F5,$01,$00,$05,f5,5,5
-F6,$01,$00,$06,f6,6,6
-F7,$01,$00,$07,f7,7,7
-F8,$01,$00,$08,f8,8,8
-F9,$01,$00,$09,f9,9,9
-F10,$01,$00,$0f,f10,10,10
-F11,$01,$00,$0b,f11,11,11
-F12,$01,$00,$0c,f12,12,12
-F13,$01,$00,$0d,f13,13,13
-F14,$01,$00,$0e,f14,14,14
-F15,$01,$00,$0f,f15,15,15
-
+F0,$02,$00,$00,f0,0,0
+F1,$02,$00,$01,f1,1,1
+F2,$02,$00,$02,f2,2,2
+F3,$02,$00,$03,f3,3,3
+F4,$02,$00,$04,f4,4,4
+F5,$02,$00,$05,f5,5,5
+F6,$02,$00,$06,f6,6,6
+F7,$02,$00,$07,f7,7,7
+F8,$02,$00,$08,f8,8,8
+F9,$02,$00,$09,f9,9,9
+F10,$02,$00,$0f,f10,10,10
+F11,$02,$00,$0b,f11,11,11
+F12,$02,$00,$0c,f12,12,12
+F13,$02,$00,$0d,f13,13,13
+F14,$02,$00,$0e,f14,14,14
+F15,$02,$00,$0f,f15,15,15
 
+; Boolean registers
+B0,$05,$00,$00,b0,0,0
+B1,$05,$00,$01,b1,1,1
+B2,$05,$00,$02,b2,2,2
+B3,$05,$00,$03,b3,3,3
+B4,$05,$00,$04,b4,4,4
+B5,$05,$00,$05,b5,5,5
+B6,$05,$00,$06,b6,6,6
+B7,$05,$00,$07,b7,7,7
+B8,$05,$00,$08,b8,8,8
+B9,$05,$00,$09,b9,9,9
+B10,$05,$00,$0b,b10,10,10
+B11,$05,$00,$0b,b11,11,11
+B12,$05,$00,$0c,b12,12,12
+B13,$05,$00,$0d,b13,13,13
+B14,$05,$00,$0e,b14,14,14
+B15,$05,$00,$0b,b15,15,15
 

packages/fcl-process/src/process.pp

@@ -27,7 +27,7 @@ Type
                     poNoConsole,poNewConsole,
                     poDefaultErrorMode,poNewProcessGroup,
                     poDebugProcess,poDebugOnlyThisProcess,
-                    poPassInput);
+                    poPassInput,porunidle);
 
   TShowWindowOptions = (swoNone,swoHIDE,swoMaximize,swoMinimize,swoRestore,swoShow,
                         swoShowDefault,swoShowMaximized,swoShowMinimized,

packages/fcl-process/src/processbody.inc

@@ -562,7 +562,7 @@ begin
         if assigned(stderr) then
             gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1);
  
-        if not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then
+        if (porunidle in options) and not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then
           FOnRunCommandEvent(self,Nil,RunCommandIdle,'');
       end;
     // Get left output after end of execution

packages/fcl-registry/src/regini.inc

@@ -300,18 +300,18 @@ begin
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
+    k:=GetKey('\'+CurrentPath+'\'+S)
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
   Result:=True;
 end;
 

packages/fcl-registry/src/registry.pp

@@ -57,6 +57,7 @@ type
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fCurrentPath: UnicodeString;
+    function FixPath(APath: UnicodeString): UnicodeString;
     function GetLastErrorMsg: string;
     function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
     function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
@@ -103,8 +104,8 @@ type
     function HasSubKeys: Boolean;
     function KeyExists(const Key: UnicodeString): Boolean;
     function KeyExists(const Key: String): Boolean;
-    function LoadKey(const Key, FileName: UnicodeString): Boolean;
-    function LoadKey(const Key, FileName: String): Boolean;
+    function LoadKey(const Key, FileName: UnicodeString): Boolean;  unimplemented;
+    function LoadKey(const Key, FileName: String): Boolean;  unimplemented;
     function OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
     function OpenKey(const Key: String; CanCreate: Boolean): Boolean;
     function OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -135,10 +136,10 @@ type
     function ReadTime(const Name: String): TDateTime;
     function RegistryConnect(const UNCName: UnicodeString): Boolean;
     function RegistryConnect(const UNCName: String): Boolean;
-    function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean;
-    function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean;
-    function RestoreKey(const Key, FileName: UnicodeString): Boolean;
-    function RestoreKey(const Key, FileName: String): Boolean;
+    function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean; unimplemented;
+    function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean;  unimplemented;
+    function RestoreKey(const Key, FileName: UnicodeString): Boolean;  unimplemented;
+    function RestoreKey(const Key, FileName: String): Boolean;  unimplemented;
     function SaveKey(const Key, FileName: UnicodeString): Boolean;
     function SaveKey(const Key, FileName: String): Boolean;
     function UnLoadKey(const Key: UnicodeString): Boolean;
@@ -153,14 +154,14 @@ type
     procedure GetValueNames(Strings: TStrings);
     //ToDo
     function GetValueNames: TUnicodeStringArray;
-    procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);
-    procedure MoveKey(const OldName, NewName: String; Delete: Boolean);
+    procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);  unimplemented;
+    procedure MoveKey(const OldName, NewName: String; Delete: Boolean);  unimplemented;
     procedure RenameValue(const OldName, NewName: UnicodeString);
     procedure RenameValue(const OldName, NewName: String);
     procedure WriteCurrency(const Name: UnicodeString; Value: Currency);
     procedure WriteCurrency(const Name: String; Value: Currency);
-    procedure WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer);
-    procedure WriteBinaryData(const Name: String; var Buffer; BufSize: Integer);
+    procedure WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer);
+    procedure WriteBinaryData(const Name: String; const Buffer; BufSize: Integer);
     procedure WriteBool(const Name: UnicodeString; Value: Boolean);
     procedure WriteBool(const Name: String; Value: Boolean);
     procedure WriteDate(const Name: UnicodeString; Value: TDateTime);
@@ -250,7 +251,7 @@ type
     function ReadFloat(const Section, Name: string; Default: Double): Double; override;
     function ReadString(const Section, Name, Default: string): string; override;
     function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override;
-    function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override;
+    function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override; unimplemented;
     procedure WriteDate(const Section, Name: string; Value: TDateTime); override;
     procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override;
     procedure WriteFloat(const Section, Name: string; Value: Double); override;
@@ -545,9 +546,7 @@ end;
 function TRegistry.ReadDate(const Name: UnicodeString): TDateTime;
 
 begin
-  Result:=Default(TDateTime);
-  ReadBinaryData(Name, Result, SizeOf(TDateTime));
-  Result:=Trunc(Result);
+  Result:=Trunc(ReadDateTime(Name));
 end;
 
 function TRegistry.ReadDate(const Name: String): TDateTime;
@@ -632,6 +631,19 @@ begin
   ReadStringList(UnicodeString(Name), AList);
 end;
 
+function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
+const
+  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
+begin
+  //At this point we know the path is valid, since this is only called after OpenKey succeeded
+  //Just sanitize it
+  while (Pos(Delim+Delim,APath) > 0) do
+    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
+  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
+    System.Delete(APath, Length(APath), 1);
+  Result := APath;
+end;
+
 function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
 var
   Len, i, p: Integer;
@@ -740,9 +752,7 @@ end;
 function TRegistry.ReadTime(const Name: UnicodeString): TDateTime;
 
 begin
-  Result:=Default(TDateTime);
-  ReadBinaryData(Name, Result, SizeOf(TDateTime));
-  Result:=Frac(Result);
+  Result:=Frac(ReadDateTime(Name));
 end;
 
 function TRegistry.ReadTime(const Name: String): TDateTime;
@@ -780,12 +790,12 @@ begin
   Result:=ValueExists(UnicodeString(Name));
 end;
 
-procedure TRegistry.WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer);
+procedure TRegistry.WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer);
 begin
   PutData(Name, @Buffer, BufSize, rdBinary);
 end;
 
-procedure TRegistry.WriteBinaryData(const Name: String; var Buffer;
+procedure TRegistry.WriteBinaryData(const Name: String; const Buffer;
   BufSize: Integer);
 begin
   WriteBinaryData(UnicodeString(Name), Buffer, BufSize);

packages/fcl-registry/src/winreg.inc

@@ -227,8 +227,12 @@ begin
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
-    else
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end  else
       S:=u;
     ChangeKey(Handle, S);
   end;
@@ -325,7 +329,7 @@ procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 
@@ -419,8 +423,6 @@ Function TRegistry.SysPutData(const Name: UnicodeString; Buffer: Pointer;
 
 Var
   RegDataType: DWORD;
-  B : Pchar;
-  S : String;
 
 begin
   RegDataType:=RegDataWords[RegData];

packages/fcl-registry/src/xmlreg.pp

@@ -81,6 +81,7 @@ Type
     // These interpret the Data buffer as unicode data
     Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;

packages/fcl-registry/src/xregreg.inc

@@ -223,9 +223,22 @@ end;
 
 function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
+var
+  S: UnicodeString;
+  P: SizeInt;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
+  If Result then begin
+    S:=TXmlRegistry(FSysData).CurrentKey;
+    if (S>'') then begin
+      //S starts with RootKey+'/'
+      P:=Pos('/',S);
+      if (P>0) then
+        System.Delete(S,1,P);
+    end;
+    ChangeKey(FCurrentKey, S);
+  end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -266,7 +279,7 @@ end;
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;

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.