paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 14:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
florian 2021-09-05 21:03:31 +02:00
parent 468975aa30
commit a5f6505edc
6 changed files with 49 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/ncgmem.pas
View File

@ -815,7 +815,10 @@ implementation
st_widestring, st_widestring,
st_ansistring: st_ansistring:
begin 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); pd:=search_system_proc(helpername);
paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1); paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2); paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);

6
rtl/inc/astrings.inc
View File

@ -759,6 +759,12 @@ begin
if (p=nil) or (index>PAnsiRec(p-AnsiFirstOff)^.Len) or (Index<1) then if (p=nil) or (index>PAnsiRec(p-AnsiFirstOff)^.Len) or (Index<1) then
HandleErrorAddrFrameInd(201,get_pc_addr,get_frame); HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
end; 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} {$endif FPC_HAS_ANSISTR_RANGECHECK}
{$ifndef FPC_HAS_ANSISTR_SETLENGTH} {$ifndef FPC_HAS_ANSISTR_SETLENGTH}

3
rtl/inc/compproc.inc
View File

@ -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(const S1,S2 : RawByteString): SizeInt; compilerproc;
Function fpc_AnsiStr_Compare_equal(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_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; 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}; 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(const S1,S2 : WideString): SizeInt; compilerproc;
Function fpc_WideStr_Compare_equal(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_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; 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}; 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(const S1,S2 : UnicodeString): SizeInt; compilerproc;
Function fpc_UnicodeStr_Compare_equal(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_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; 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}; Function fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc{$ifndef VER3_0}:fpc_in_copy_x{$endif VER3_0};

6
rtl/inc/ustrings.inc
View File

@ -939,6 +939,12 @@ begin
if (p=nil) or (index>PUnicodeRec(p-UnicodeFirstOff)^.len) or (Index<1) then if (p=nil) or (index>PUnicodeRec(p-UnicodeFirstOff)^.len) or (Index<1) then
HandleErrorAddrFrameInd(201,get_pc_addr,get_frame); HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
end; 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} {$endif FPC_HAS_UNICODESTR_RANGECHECK}

6
rtl/inc/wstrings.inc
View File

@ -483,6 +483,12 @@ begin
HandleErrorAddrFrameInd(201,get_pc_addr,get_frame); HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
end; 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; Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
{ {
Sets The length of string S to L. Sets The length of string S to L.

24
tests/webtbs/tw39323.pp Normal file
View File

@ -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.