From af2c7bf00f9eb8876c30e3e3c9bd11e78eb1b276 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 4 Jul 2015 22:28:31 +0000
Subject: [PATCH]   * don't perform CSE on typeconversion nodes inserted for
 absolute     references, or anything below them (mantis #27210)

git-svn-id: trunk@31193 -
---
 .gitattributes          |  1 +
 compiler/optcse.pas     | 13 ++++++++++---
 tests/webtbs/tw27210.pp | 31 +++++++++++++++++++++++++++++++
 3 files changed, 42 insertions(+), 3 deletions(-)
 create mode 100755 tests/webtbs/tw27210.pp

diff --git a/.gitattributes b/.gitattributes
index 3c75d6f66f..e032930777 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -14468,6 +14468,7 @@ tests/webtbs/tw27153.pp svneol=native#text/pascal
 tests/webtbs/tw27173.pp svneol=native#text/pascal
 tests/webtbs/tw27185.pp svneol=native#text/pascal
 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/tw2725.pp svneol=native#text/plain
 tests/webtbs/tw27256.pp svneol=native#text/pascal
diff --git a/compiler/optcse.pas b/compiler/optcse.pas
index 3b8cefd530..a7c0d08cbf 100644
--- a/compiler/optcse.pas
+++ b/compiler/optcse.pas
@@ -143,9 +143,16 @@ unit optcse;
         { don't add the tree below an untyped const parameter: there is
           no information available that this kind of tree actually needs
           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
             result:=fen_norecurse_false;
             exit;
diff --git a/tests/webtbs/tw27210.pp b/tests/webtbs/tw27210.pp
new file mode 100755
index 0000000000..c51924979a
--- /dev/null
+++ b/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.