Browse Source

Fix cycling after addition of the new case simplification.

nset.pas, tcasenode.simplify: don't assume a specific order of the case labels

+ added test based on ppu.pas, tppu.getaint where no matching case label was found because of the ordering

git-svn-id: trunk@26825 -
svenbarth 11 years ago
parent
commit
60a07770f1
3 changed files with 63 additions and 15 deletions
  1. 1 0
      .gitattributes
  2. 20 15
      compiler/nset.pas
  3. 42 0
      tests/tbs/tb0605.pp

+ 1 - 0
.gitattributes

@@ -10161,6 +10161,7 @@ tests/tbs/tb0601.pp svneol=native#text/pascal
 tests/tbs/tb0602.pp svneol=native#text/plain
 tests/tbs/tb0603.pp svneol=native#text/pascal
 tests/tbs/tb0604.pp svneol=native#text/pascal
+tests/tbs/tb0605.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain

+ 20 - 15
compiler/nset.pas

@@ -844,27 +844,32 @@ implementation
     function tcasenode.simplify(forinline:boolean):tnode;
       var
         tmp: pcaselabel;
+        walkup: boolean;
       begin
         result:=nil;
         if left.nodetype=ordconstn then
           begin
             tmp:=labels;
-            { walk the case labels as long as the upper bound is smaller than
-              the constant }
-            while assigned(tmp) and (tmp^._high<tordconstnode(left).value) do
-              tmp:=tmp^.greater;
-            { check whether the constant is inside the range }
-            if assigned(tmp) and
-                (tmp^._low<=tordconstnode(left).value) and
-                (tmp^._high>=tordconstnode(left).value) then
+            { check all case labels until we find one that fits }
+            walkup:=assigned(tmp^.greater);
+            while assigned(tmp) do
               begin
-                if tmp^.blockid>=blocks.count then
-                  internalerror(2014022101);
-                result:=pcaseblock(blocks[tmp^.blockid])^.statement;
-                if not assigned(result) then
-                  internalerror(2014022102);
-                result:=result.getcopy;
-                exit;
+                if (tmp^._low<=tordconstnode(left).value) and
+                    (tmp^._high>=tordconstnode(left).value) then
+                  begin
+                    if tmp^.blockid>=blocks.count then
+                      internalerror(2014022101);
+                    result:=pcaseblock(blocks[tmp^.blockid])^.statement;
+                    if not assigned(result) then
+                      internalerror(2014022102);
+                    result:=result.getcopy;
+                    exit;
+                  end;
+
+                if walkup then
+                  tmp:=tmp^.greater
+                else
+                  tmp:=tmp^.less;
               end;
             { no label did match; use the else block if available }
             if assigned(elseblock) then

+ 42 - 0
tests/tbs/tb0605.pp

@@ -0,0 +1,42 @@
+program tb0605;
+
+{$mode objfpc}
+
+type
+  aint = longint;
+
+function getint64: int64;
+begin
+  Result := 64;
+end;
+
+function getlongint: longint;
+begin
+  Result := 32;
+end;
+
+function getword: word;
+begin
+  result := 16;
+end;
+
+function getbyte: byte;
+begin
+  result := 8;
+end;
+
+function getaint: longint;
+begin
+  result:=4;
+  case sizeof(aint) of
+    8: result:=getint64;
+    4: result:=getlongint;
+    2: result:=smallint(getword);
+    1: result:=shortint(getbyte);
+  end;
+end;
+
+begin
+  if getaint <> 32 then
+    Halt(1);
+end.