From 340e2257f3d70ecc93b7be68f98a435a4f92a483 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 27 Aug 2006 11:08:39 +0000
Subject: [PATCH]   * don't allow taking the address of packed record fields  
 * don't allow using packed record fields as loopvars

git-svn-id: trunk@4509 -
---
 .gitattributes        |  2 ++
 compiler/htypechk.pas |  9 +++++++++
 tests/test/tprec10.pp | 15 +++++++++++++++
 tests/test/tprec9.pp  | 13 +++++++++++++
 4 files changed, 39 insertions(+)
 create mode 100644 tests/test/tprec10.pp
 create mode 100644 tests/test/tprec9.pp

diff --git a/.gitattributes b/.gitattributes
index 9ed31ccedd..9210a5e22b 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6153,6 +6153,7 @@ tests/test/tparray8.pp svneol=native#text/plain
 tests/test/tparray9.pp svneol=native#text/plain
 tests/test/tpftch1.pp svneol=native#text/plain
 tests/test/tprec1.pp svneol=native#text/plain
+tests/test/tprec10.pp svneol=native#text/plain
 tests/test/tprec2.pp svneol=native#text/plain
 tests/test/tprec3.pp svneol=native#text/plain
 tests/test/tprec4.pp svneol=native#text/plain
@@ -6160,6 +6161,7 @@ tests/test/tprec5.pp svneol=native#text/plain
 tests/test/tprec6.pp svneol=native#text/plain
 tests/test/tprec7.pp svneol=native#text/plain
 tests/test/tprec8.pp svneol=native#text/plain
+tests/test/tprec9.pp svneol=native#text/plain
 tests/test/tprocext.pp svneol=native#text/plain
 tests/test/tprocvar1.pp svneol=native#text/plain
 tests/test/tprocvar2.pp svneol=native#text/plain
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 8d9d51235a..820429648a 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -1087,6 +1087,15 @@ implementation
                end;
              subscriptn :
                begin
+                 { only check first (= outermost) subscriptn }
+                 if not gotsubscript and
+                    not(valid_packed in opts) and
+                    is_packed_record_or_object(tsubscriptnode(hp).left.resulttype.def) then
+                   begin
+                     if report_errors then
+                       CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr_loop);
+                     exit;
+                   end;
                  gotsubscript:=true;
                  { loop counter? }
                  if not(Valid_Const in opts) and
diff --git a/tests/test/tprec10.pp b/tests/test/tprec10.pp
new file mode 100644
index 0000000000..a0ae12628c
--- /dev/null
+++ b/tests/test/tprec10.pp
@@ -0,0 +1,15 @@
+{ %fail }
+
+{$mode tp}
+
+type
+  tr = bitpacked record
+    a,b: 0..7;
+  end;
+
+var
+  r: tr;
+begin
+  for r.a := 0 to 4 do
+    writeln; 
+end.
diff --git a/tests/test/tprec9.pp b/tests/test/tprec9.pp
new file mode 100644
index 0000000000..c117ac4a38
--- /dev/null
+++ b/tests/test/tprec9.pp
@@ -0,0 +1,13 @@
+{ %fail }
+
+type
+  tr = bitpacked record
+    a,b: 0..7;
+  end;
+
+var
+  r: tr;
+  p: pointer;
+begin
+  p := @r.b;
+end.