瀏覽代碼

* don't perform CSE on typeconversion nodes inserted for absolute
references, or anything below them (mantis #27210)

git-svn-id: trunk@31193 -

Jonas Maebe 10 年之前
父節點
當前提交
af2c7bf00f
共有 3 個文件被更改,包括 42 次插入3 次删除
  1. 1 0
      .gitattributes
  2. 10 3
      compiler/optcse.pas
  3. 31 0
      tests/webtbs/tw27210.pp

+ 1 - 0
.gitattributes

@@ -14468,6 +14468,7 @@ tests/webtbs/tw27153.pp svneol=native#text/pascal
 tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
 tests/webtbs/tw2721.pp svneol=native#text/plain
 tests/webtbs/tw2721.pp svneol=native#text/plain
+tests/webtbs/tw27210.pp svneol=native#text/plain
 tests/webtbs/tw2723.pp svneol=native#text/plain
 tests/webtbs/tw2723.pp svneol=native#text/plain
 tests/webtbs/tw2725.pp svneol=native#text/plain
 tests/webtbs/tw2725.pp svneol=native#text/plain
 tests/webtbs/tw27256.pp svneol=native#text/pascal
 tests/webtbs/tw27256.pp svneol=native#text/pascal

+ 10 - 3
compiler/optcse.pas

@@ -143,9 +143,16 @@ unit optcse;
         { don't add the tree below an untyped const parameter: there is
         { don't add the tree below an untyped const parameter: there is
           no information available that this kind of tree actually needs
           no information available that this kind of tree actually needs
           to be addresable, this could be improved }
           to be addresable, this could be improved }
-        if ((n.nodetype=callparan) and
-          (tcallparanode(n).left.resultdef.typ=formaldef) and
-          (tcallparanode(n).parasym.varspez=vs_const)) then
+        { the nodes below a type conversion node created for an absolute
+          reference cannot be handled separately, because the absolute reference
+          may have special requirements (no regability, must be in memory, ...)
+        }
+        if (((n.nodetype=callparan) and
+             (tcallparanode(n).left.resultdef.typ=formaldef) and
+             (tcallparanode(n).parasym.varspez=vs_const)) or
+            ((n.nodetype=typeconvn) and
+             (nf_absolute in n.flags))
+           ) then
           begin
           begin
             result:=fen_norecurse_false;
             result:=fen_norecurse_false;
             exit;
             exit;

+ 31 - 0
tests/webtbs/tw27210.pp

@@ -0,0 +1,31 @@
+{$mode delphi}
+
+program TestAbsolute; {$apptype console}
+
+function IsInt16 (L : longint) : boolean;
+var W : smallint absolute L;
+begin
+  Result := longint (W) = L;
+end;
+
+function IsInt32 (Q : int64) : boolean;
+var L : longint absolute Q;
+begin
+  Result := int64 (L) = Q;
+end;
+
+const VL1 : longint = -1;
+      VL2 : longint = $12345678;
+      VQ1 : int64   = -1;
+      VQ2 : int64   = $123456781234;
+
+begin
+  if not IsInt16 (VL1) then
+    halt(1);
+  if IsInt16 (VL2) then
+    halt(2);
+  if not IsInt32 (VQ1) then
+    halt(3);
+  if IsInt32 (VQ2) then
+    halt(4);
+end.