From 0d6a1d24bd0adb93608b17fff1e956564cc4d975 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Tue, 13 Jul 2021 18:31:38 +0000
Subject: [PATCH]   * might_have_sideeffects in gen_c_style_operator as
 proposed by runewalsh, resolves #39206

git-svn-id: trunk@49608 -
---
 .gitattributes          |  1 +
 compiler/pexpr.pas      |  9 +------
 tests/webtbs/tw39206.pp | 55 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 57 insertions(+), 8 deletions(-)
 create mode 100644 tests/webtbs/tw39206.pp

diff --git a/.gitattributes b/.gitattributes
index 1377a749bb..12a010d110 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 4b5e892a7f..6a84b31186 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -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);
diff --git a/tests/webtbs/tw39206.pp b/tests/webtbs/tw39206.pp
new file mode 100644
index 0000000000..7a5b73431a
--- /dev/null
+++ b/tests/webtbs/tw39206.pp
@@ -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.