* fix range checking for zero based strings, resolves #39323

compiler/ncgmem.pas

@@ -815,7 +815,10 @@ implementation
           st_widestring,
           st_ansistring:
             begin
-              helpername:='fpc_'+tstringdef(left.resultdef).stringtypname+'_rangecheck';
+              if cs_zerobasedstrings in current_settings.localswitches then
+                helpername:='fpc_'+tstringdef(left.resultdef).stringtypname+'_zerobased_rangecheck'
+              else
+                helpername:='fpc_'+tstringdef(left.resultdef).stringtypname+'_rangecheck';
               pd:=search_system_proc(helpername);
               paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
               paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);

rtl/inc/astrings.inc

@@ -759,6 +759,12 @@ begin
   if (p=nil) or (index>PAnsiRec(p-AnsiFirstOff)^.Len) or (Index<1) then
     HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
 end;
+
+Procedure fpc_AnsiStr_ZeroBased_RangeCheck(p: Pointer; index: SizeInt);[Public,Alias : 'FPC_ANSISTR_ZEROBASED_RANGECHECK'];  compilerproc;
+begin
+  if (p=nil) or (index>=PAnsiRec(p-AnsiFirstOff)^.Len) or (Index<0) then
+    HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
+end;
 {$endif FPC_HAS_ANSISTR_RANGECHECK}
 
 {$ifndef FPC_HAS_ANSISTR_SETLENGTH}

rtl/inc/compproc.inc

@@ -323,6 +323,7 @@ procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: RawByt
 Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt; compilerproc;
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : RawByteString): SizeInt; compilerproc;
 Procedure fpc_AnsiStr_RangeCheck(p : Pointer; index : SizeInt); compilerproc;
+Procedure fpc_AnsiStr_ZeroBased_RangeCheck(p : Pointer; index : SizeInt); compilerproc;
 
 Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
 Function  fpc_ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt): RawByteString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
@@ -362,6 +363,7 @@ procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: Wi
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
+Procedure fpc_WideStr_ZeroBased_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
 
 Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt); compilerproc;
 Function  fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};
@@ -410,6 +412,7 @@ procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src:
 Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Procedure fpc_UnicodeStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
+Procedure fpc_UnicodeStr_ZeroBased_RangeCheck(p: Pointer; index : SizeInt); compilerproc;
 
 Procedure fpc_UnicodeStr_SetLength (Var S : UnicodeString; l : SizeInt); compilerproc;
 Function  fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};

rtl/inc/ustrings.inc

@@ -939,6 +939,12 @@ begin
   if (p=nil) or (index>PUnicodeRec(p-UnicodeFirstOff)^.len) or (Index<1) then
     HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
 end;
+
+Procedure fpc_UnicodeStr_ZeroBased_RangeCheck(p: Pointer; index: SizeInt);[Public,Alias : 'FPC_UNICODESTR_ZEROBASED_RANGECHECK']; compilerproc;
+begin
+  if (p=nil) or (index>=PUnicodeRec(p-UnicodeFirstOff)^.len) or (Index<0) then
+    HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
+end;
 {$endif FPC_HAS_UNICODESTR_RANGECHECK}
 
 

rtl/inc/wstrings.inc

@@ -483,6 +483,12 @@ begin
     HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
 end;
 
+Procedure fpc_WideStr_ZeroBased_RangeCheck(p: Pointer; index: SizeInt);[Public,Alias : 'FPC_WIDESTR_ZEROBASED_RANGECHECK']; compilerproc;
+begin
+  if (p=nil) or (index>=PWideRec(p-WideFirstOff)^.len div 2) or (Index<0) then
+    HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
+end;
+
 Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
 {
   Sets The length of string S to L.

tests/webtbs/tw39323.pp

@@ -0,0 +1,24 @@
+program project1;
+
+{$mode objfpc}{$H+}
+{$ZeroBasedStrings On}
+
+uses sysutils;
+
+var
+  S: String = 'Cat';
+  U: UnicodeString = 'Cat';
+  W: WideString = 'Cat';
+begin
+  S[0] := 'H';
+  if S<>'Hat' then
+    halt(1);
+  U[0] := 'H';
+  if U<>'Hat' then
+    halt(1);
+  W[0] := 'H';
+  if W<>'Hat' then
+    halt(1);
+
+  WriteLn('ok');
+end.