From 1205d05ba4617a583fd16424410b5a36a4a247f4 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Tue, 13 Mar 2007 10:17:33 +0000
Subject: [PATCH]   * make variables not regable if they are referenced by an
 absolute     variable of a different size

git-svn-id: trunk@6817 -
---
 .gitattributes         |  1 +
 compiler/pdecvar.pas   | 10 +++++++-
 tests/webtbs/tw8513.pp | 54 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw8513.pp

diff --git a/.gitattributes b/.gitattributes
index 40234e3de0..027d868b5a 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -8113,6 +8113,7 @@ tests/webtbs/tw8371.pp svneol=native#text/plain
 tests/webtbs/tw8391.pp svneol=native#text/plain
 tests/webtbs/tw8434.pp svneol=native#text/plain
 tests/webtbs/tw8462.pp svneol=native#text/plain
+tests/webtbs/tw8513.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
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 874d1fe98b..aeb6153553 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -51,7 +51,7 @@ implementation
        systems,
        { symtable }
        symconst,symbase,symtype,symtable,defutil,defcmp,
-       fmodule,
+       fmodule,htypechk,
        { pass 1 }
        node,pass_1,aasmdata,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
@@ -814,6 +814,14 @@ implementation
                   abssym.fileinfo:=vs.fileinfo;
                   abssym.abstyp:=tovar;
                   abssym.ref:=node_to_propaccesslist(pt);
+                  { if the sizes are different, can't be a regvar since you }
+                  { can't be "absolute upper 8 bits of a register" (except  }
+                  { if its a record field of the same size of a record      }
+                  { regvar, but in that case pt.resultdef.size will have    }
+                  { the same size since it refers to the field and not to   }
+                  { the whole record -- which is why we use pt and not hp)  }
+                  if (vs.vardef.size <> pt.resultdef.size) then
+                    make_not_regable(pt,vr_addr);
                 end
               else
                 Message(parser_e_absolute_only_to_var_or_const);
diff --git a/tests/webtbs/tw8513.pp b/tests/webtbs/tw8513.pp
new file mode 100644
index 0000000000..8a37d84c0d
--- /dev/null
+++ b/tests/webtbs/tw8513.pp
@@ -0,0 +1,54 @@
+type
+  TMyType = cardinal;
+  tr = record
+    a,b,c,d: byte;
+  end;
+
+procedure t(var l: cardinal);
+begin
+  if (l <> $cafebabe) then
+    halt(4);
+  l := $c001d00d;
+end;
+
+var
+  Item: TMyType;
+  ItemAsByte: byte absolute Item;
+
+  r: tr;
+  b: byte absolute r.b;
+
+  l: cardinal;
+  labs: cardinal absolute l;
+begin
+  { Of course I understand fully that this code is bad
+    (unless you really want to read the 1st byte of 4-byte LongInt
+    type, messing with endianess problems).
+
+    In real code, I accessed ItemAsByte only when
+    SizeOf(TMyType) = 1 (the code is
+    used like a simple template, so it must work with any
+    TMyType, and the case when SizeOf(TMyType) = 1 uses some
+    specially optimized versions (e.g. FillChar(..., ItemAsByte)
+    can be used in this case to fill the array of TMyType). }
+
+{$ifdef FPC_BIG_ENDIAN}
+  item:=$deadbeef;
+{$else}
+  item:=$efbeadde;
+{$endif}
+  if (itemasbyte <> $de) then
+    halt(1);
+
+  r.a := $de;
+  r.b := $ad;
+  r.c := $be;
+  r.d := $ef;
+  if (b <> $ad) then
+    halt(2);
+
+  l := $cafebabe;
+  t(labs);
+  if (l <> $c001d00d) then
+    halt(6);
+end.