* correctly simplify tree transforms of (a+c1+c2) if a is a pointer, resolves #37671

git-svn-id: trunk@47437 -

.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

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,

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;
 
 

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.