Quellcode durchsuchen

* fix overflow checking for inc(cardinal,x) and inc(pointer,x)

git-svn-id: trunk@593 -
peter vor 20 Jahren
Ursprung
Commit
f2f968f48a
3 geänderte Dateien mit 29 neuen und 1 gelöschten Zeilen
  1. 1 0
      .gitattributes
  2. 10 1
      compiler/ninl.pas
  3. 18 0
      tests/webtbs/tw4152.pp

+ 1 - 0
.gitattributes

@@ -6133,6 +6133,7 @@ tests/webtbs/tw4119.pp svneol=native#text/plain
 tests/webtbs/tw4140.pp svneol=native#text/plain
 tests/webtbs/tw4150.pp svneol=native#text/plain
 tests/webtbs/tw4151.pp svneol=native#text/plain
+tests/webtbs/tw4152.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 10 - 1
compiler/ninl.pas

@@ -2175,8 +2175,17 @@ implementation
                        { no, create constant 1 }
                        hpp := cordconstnode.create(1,tcallparanode(left).left.resulttype,false);
                      end;
-                   if (tcallparanode(left).left.resulttype.def.deftype=pointerdef) then
+                   resulttypepass(hpp);
+{$ifndef cpu64bit}
+                   if not((hpp.resulttype.def.deftype=orddef) and
+                          (torddef(hpp.resulttype.def).typ<>u32bit)) then
+{$endif 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.resulttype.def.deftype=pointerdef) then
+                     exclude(aktlocalswitches,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

+ 18 - 0
tests/webtbs/tw4152.pp

@@ -0,0 +1,18 @@
+{ Source provided for Free Pascal Bug Report 4152 }
+{ Submitted by "C Western" on  2005-07-03 }
+{ e-mail: [email protected] }
+{$R+}{$Q+}
+var
+  p:^Byte;
+  c:Byte;
+  d:Integer;
+  v : cardinal;
+begin
+  v:=100;
+  inc(v,-1);
+  p:=@c;
+  Inc(p,-1);  // Gives compile time error: range check error while evaluating constants
+  d:=2;
+  Inc(d,-1);
+  Inc(p,d); // This fails at run time
+end.