From 6380df9b42d29b7db0301f50fa948f90f78521ca Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Mon, 16 Nov 2020 21:47:19 +0000
Subject: [PATCH]   * correctly simplify tree transforms of (a+c1+c2) if a is a
 pointer, resolves #37671

git-svn-id: trunk@47437 -
---
 .gitattributes          |  1 +
 compiler/nadd.pas       |  8 ++++++--
 compiler/ncnv.pas       |  7 +++++--
 tests/webtbs/tw37621.pp | 38 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 50 insertions(+), 4 deletions(-)
 create mode 100644 tests/webtbs/tw37621.pp

diff --git a/.gitattributes b/.gitattributes
index 9a7b9c9b29..95a3e9de72 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -18504,6 +18504,7 @@ tests/webtbs/tw37508.pp svneol=native#text/pascal
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw37554.pp svneol=native#text/pascal
 tests/webtbs/tw3758.pp svneol=native#text/plain
+tests/webtbs/tw37621.pp -text svneol=native#text/pascal
 tests/webtbs/tw3764.pp svneol=native#text/plain
 tests/webtbs/tw3765.pp svneol=native#text/plain
 tests/webtbs/tw37650.pp svneol=native#text/pascal
diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index ce1ab9743a..e30814d063 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -490,7 +490,7 @@ implementation
 
 
       var
-        t,vl,hp,lefttarget,righttarget: tnode;
+        t,vl,hp,lefttarget,righttarget, hp2: tnode;
         lt,rt   : tnodetype;
         hdef,
         rd,ld   , inttype: tdef;
@@ -793,7 +793,11 @@ implementation
                           { keep the order of val+const else pointer operations might cause an error }
                           hp:=taddnode(left).left;
                           taddnode(left).left:=right;
-                          left:=left.simplify(forinline);
+                          left.resultdef:=nil;
+                          do_typecheckpass(left);
+                          hp2:=left.simplify(forinline);
+                          if assigned(hp2) then
+                            left:=hp2;
                           if resultdef.typ<>pointerdef then
                             begin
                               { ensure that the constant is not expanded to a larger type due to overflow,
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 578f242c8c..863292aa55 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -4117,7 +4117,9 @@ implementation
 
     function ttypeconvnode.retains_value_location:boolean;
       begin
-        result:=(convtype=tc_equal) or
+        result:=assigned(left.resultdef) and
+                (
+                (convtype=tc_equal) or
                 { typecasting from void is always allowed }
                 is_void(left.resultdef) or
                 (left.resultdef.typ=formaldef) or
@@ -4139,7 +4141,8 @@ implementation
                 { on managed platforms, converting an element to an open array
                   involves creating an actual array -> value location changes }
                 ((convtype=tc_elem_2_openarray) and
-                 not(target_info.system in systems_managed_vm));
+                 not(target_info.system in systems_managed_vm))
+                );
       end;
 
 
diff --git a/tests/webtbs/tw37621.pp b/tests/webtbs/tw37621.pp
new file mode 100644
index 0000000000..63384dc528
--- /dev/null
+++ b/tests/webtbs/tw37621.pp
@@ -0,0 +1,38 @@
+program twctest;
+
+{$mode delphi}
+{$define InlineFuncs}
+
+type
+  REChar = WideChar;
+  TRENextOff = PtrInt;
+  PRegExprChar = PWideChar;
+  TREOp = REChar; // internal p-code type //###0.933
+
+const
+  REOpSz = SizeOf(TREOp) div SizeOf(REChar);
+  RENextOffSz = (SizeOf(TRENextOff) div SizeOf(REChar));
+
+function CheckCharCategory(AChar: REChar; Ch0, Ch1: REChar): boolean;
+// AChar: check this char against opcode
+// Ch0, Ch1: opcode operands after OP_*CATEGORY
+begin
+end;
+
+function MatchOneCharCategory(opnd, scan: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
+// opnd: points to opcode operands after OP_*CATEGORY
+// scan: points into InputString
+begin
+  Result := CheckCharCategory(scan^, opnd^, (opnd + 1)^);
+end;
+
+procedure Test;
+var
+  scan, reginput: PRegExprChar;
+begin
+  if not MatchOneCharCategory(scan + REOpSz + RENextOffSz, reginput) then Exit;
+end;
+
+begin
+  Test;
+end.