* support inc(pointer) in TP mode with range/overflow checking on as well

git-svn-id: trunk@5605 -

.gitattributes

@@ -7779,6 +7779,7 @@ tests/webtbs/tw7679.pp svneol=native#text/plain
 tests/webtbs/tw7756.pp svneol=native#text/plain
 tests/webtbs/tw7817a.pp svneol=native#text/plain
 tests/webtbs/tw7817b.pp svneol=native#text/plain
+tests/webtbs/tw7847.pp svneol=native#text/plain
 tests/webtbs/tw7963.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/ncginl.pas

@@ -464,16 +464,21 @@ implementation
                  cg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],
                    hregister,tcallparanode(left).left.location);
              end;
-          { things which can overflow must NOT pass via here, but have to be  }
-          { handled via a regular add node (conversion in tinlinenode.pass_1) }
-          { Or someone has to rewrite the above to use a_op_const_reg_reg_ov  }
-          { and friends in case of overflow checking, and ask everyone to     }
-          { implement these methods since they don't exist for all cpus (JM)  }
-          if (cs_check_overflow in current_settings.localswitches) then
-            internalerror(2006111010);
-//          cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
-          cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,
-              tcallparanode(left).left.resultdef);
+          { no overflow checking for pointers (see ninl), and range checking }
+          { is not applicable for them                                       }
+          if (tcallparanode(left).left.resultdef.typ <> pointerdef) then
+            begin
+              { things which can overflow must NOT pass via here, but have to be  }
+              { handled via a regular add node (conversion in tinlinenode.pass_1) }
+              { Or someone has to rewrite the above to use a_op_const_reg_reg_ov  }
+              { and friends in case of overflow checking, and ask everyone to     }
+              { implement these methods since they don't exist for all cpus (JM)  }
+              if (cs_check_overflow in current_settings.localswitches) then
+                internalerror(2006111010);
+    //          cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
+              cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,
+                 tcallparanode(left).left.resultdef);
+            end;
         end;
 
 

compiler/ninl.pas

@@ -2310,7 +2310,11 @@ implementation
 
                { range/overflow checking doesn't work properly }
                { with the inc/dec code that's generated (JM)   }
-               if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) then
+               if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and
+                 { No overflow check for pointer operations, because inc(pointer,-1) will always
+                   trigger an overflow. For uint32 it works because then the operation is done
+                   in 64bit. Range checking is not applicable to pointers either }
+                  (tcallparanode(left).left.resultdef.typ<>pointerdef) then
                  { convert to simple add (JM) }
                  begin
                    newblock := internalstatements(newstatement);
@@ -2337,11 +2341,6 @@ implementation
                           (torddef(hpp.resultdef).ordtype<>u64bit)) then
 {$endif not cpu64bit}
                      inserttypeconv_internal(hpp,sinttype);
-                   { No overflow check for pointer operations, because inc(pointer,-1) will always
-                     trigger an overflow. For uint32 it works because then the operation is done
-                     in 64bit }
-                   if (tcallparanode(left).left.resultdef.typ=pointerdef) then
-                     exclude(current_settings.localswitches,cs_check_overflow);
                    { make sure we don't call functions part of the left node twice (and generally }
                    { optimize the code generation)                                                }
                    if node_complexity(tcallparanode(left).left) > 1 then
@@ -2361,8 +2360,7 @@ implementation
 
                    resultnode := hp.getcopy;
                    { avoid type errors from the addn/subn }
-                   if not is_integer(resultnode.resultdef) and
-                      (resultnode.resultdef.typ <> pointerdef) then
+                   if not is_integer(resultnode.resultdef) then
                      begin
                        inserttypeconv_internal(hp,sinttype);
                        inserttypeconv_internal(hpp,sinttype);
@@ -2374,8 +2372,7 @@ implementation
                    else
                      hpp := caddnode.create(subn,hp,hpp);
                    { assign result of addition }
-                   if not(is_integer(resultnode.resultdef)) and
-                      (resultnode.resultdef.typ <> pointerdef) then
+                   if not(is_integer(resultnode.resultdef)) then
                      inserttypeconv(hpp,torddef.create(
 {$ifdef cpu64bit}
                        s64bit,

tests/webtbs/tw7847.pp

@@ -0,0 +1,31 @@
+{$mode tp}
+
+{$r+}
+{$q+}
+
+FUNCTION MemCompare(VAR Rec1, Rec2; Count : WORD) : INTEGER;
+TYPE PByte = ^BYTE;
+VAR PB1, PB2 : PBYTE;
+    i : INTEGER;
+BEGIN
+ MemCompare := 0;
+
+ PB1 := PByte(@Rec1);
+ PB2 := PByte(@Rec2);
+ FOR i := 1 TO Count DO
+  BEGIN
+   IF PB1^ <> PB2^ THEN
+    BEGIN
+     IF PB1^ > PB2^ THEN
+       MemCompare := 1
+     ELSE
+       MemCompare := -1;
+     BREAK;
+    END;
+   Inc(PB1); { Error is generated at this line }
+   Inc(PB2);
+  END;
+END;
+
+begin
+end.