paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 15:47:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* might_have_sideeffects in gen_c_style_operator as proposed by runewalsh, resolves #39206

Browse Source 
git-svn-id: trunk@49608 -
This commit is contained in:
florian 2021-07-13 18:31:38 +00:00
parent 9394158fe2
commit 0d6a1d24bd
3 changed files with 57 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -18892,6 +18892,7 @@ tests/webtbs/tw3900.pp svneol=native#text/plain
tests/webtbs/tw39030.pp svneol=native#text/pascal
tests/webtbs/tw3913.pp svneol=native#text/plain
tests/webtbs/tw39178.pp svneol=native#text/pascal
tests/webtbs/tw39206.pp svneol=native#text/pascal
tests/webtbs/tw3930.pp svneol=native#text/plain
tests/webtbs/tw3931a.pp svneol=native#text/plain
tests/webtbs/tw3939.pp svneol=native#text/plain

9
compiler/pexpr.pas
View File

@ -225,7 +225,6 @@ implementation
function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
var
hp : tnode;
hdef : tdef;
temp : ttempcreatenode;
newstatement : tstatementnode;
@ -240,13 +239,7 @@ implementation
result can be wrong }
end;
hp:=p1;
while assigned(hp) and
(hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do
hp:=tunarynode(hp).left;
if not assigned(hp) then
internalerror(200410121);
if (hp.nodetype=calln) then
if might_have_sideeffects(p1,[mhs_exceptions]) then
begin
typecheckpass(p1);
result:=internalstatements(newstatement);

55
tests/webtbs/tw39206.pp Normal file
View File

@ -0,0 +1,55 @@
{$mode objfpc} {$h+} {$coperators on}
var
a: array[0 .. 3] of uint32;
whatToIncrementNext: SizeUint;
procedure Reset;
begin
whatToIncrementNext := 0;
FillChar(pUint32(a)^, length(a) * sizeof(a[0]), 0);
writeln('Before: ', a[0], ' ', a[1], ' ', a[2], ' ', a[3], LineEnding);
end;
function NextIndex: SizeUint;
begin
result := whatToIncrementNext;
writeln('Incrementing ', whatToIncrementNext, 'th element');
whatToIncrementNext := (whatToIncrementNext + 1) mod length(a);
end;
function NextPtr: pUint32;
begin
result := @a[whatToIncrementNext];
writeln('Incrementing ', whatToIncrementNext, 'th element');
whatToIncrementNext := (whatToIncrementNext + 1) mod length(a);
end;
var
incr: uint32;
begin
Reset;
for incr in specialize TArray<uint32>.Create(1, 2, 4, 8) do
begin
writeln('a[NextIndex()] += ', incr, '...');
a[NextIndex] += incr;
writeln(a[0], ' ', a[1], ' ', a[2], ' ', a[3], LineEnding);
end;
if (a[0]<>1) or (a[1]<>2) or (a[2]<>4) or (a[3]<>8) then
halt(1);
Reset;
for incr in specialize TArray<uint32>.Create(1, 2, 4, 8) do
begin
writeln('NextPtr()^ += ', incr, '...');
NextPtr^ += incr;
writeln(a[0], ' ', a[1], ' ', a[2], ' ', a[3], LineEnding);
end;
if (a[0]<>1) or (a[1]<>2) or (a[2]<>4) or (a[3]<>8) then
halt(1);
writeln('ok');
end.