* allow taking the address of fields of packed records iff

   * their offset is a multiple of 8 bits; and
   * their size is a multiple of 8 bits; and
   * if it's a range type, the size is also a power of 2

git-svn-id: trunk@7609 -

.gitattributes

@@ -6923,6 +6923,10 @@ tests/test/tprec11.pp svneol=native#text/plain
 tests/test/tprec12.pp svneol=native#text/plain
 tests/test/tprec13.pp svneol=native#text/plain
 tests/test/tprec14.pp svneol=native#text/plain
+tests/test/tprec15.pp svneol=native#text/plain
+tests/test/tprec16.pp svneol=native#text/plain
+tests/test/tprec17.pp svneol=native#text/plain
+tests/test/tprec18.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

compiler/htypechk.pas

@@ -954,7 +954,8 @@ implementation
         gotderef : boolean;
         fromdef,
         todef    : tdef;
-        errmsg   : longint;
+        errmsg,
+        temp     : longint;
       begin
         if valid_const in opts then
           errmsg:=type_e_variable_id_expected
@@ -1164,7 +1165,10 @@ implementation
                  { only check first (= outermost) subscriptn }
                  if not gotsubscript and
                     not(valid_packed in opts) and
-                    is_packed_record_or_object(tsubscriptnode(hp).left.resultdef) then
+                    is_packed_record_or_object(tsubscriptnode(hp).left.resultdef) and
+                    ((tsubscriptnode(hp).vs.fieldoffset mod 8 <> 0) or
+                     (is_ordinal(tsubscriptnode(hp).resultdef) and
+                      not ispowerof2(tsubscriptnode(hp).resultdef.packedbitsize div 8,temp)))  then
                    begin
                      if report_errors then
                        if (valid_property in opts) then

tests/test/tprec15.pp

@@ -0,0 +1,42 @@
+type
+  tr = bitpacked record
+    a,b,c: byte;
+    d,e:0..15;
+    f: byte;
+    g: 0..$ffffff; { 3 bytes }
+    h: byte;
+  end;
+
+procedure p(var b: byte);
+begin
+  b := $12
+end;
+
+var
+  r: tr;
+begin
+  fillchar(r,sizeof(r),0);
+  p(r.a);
+  if (r.a<>$12) then
+    halt(1);
+
+  fillchar(r,sizeof(r),0);
+  p(r.b);
+  if (r.b<>$12) then
+    halt(1);
+
+  fillchar(r,sizeof(r),0);
+  p(r.c);
+  if (r.c<>$12) then
+    halt(1);
+
+  fillchar(r,sizeof(r),0);
+  p(r.f);
+  if (r.f<>$12) then
+    halt(1);
+
+  fillchar(r,sizeof(r),0);
+  p(r.h);
+  if (r.h<>$12) then
+    halt(1);
+end.

tests/test/tprec16.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+type
+  tr = bitpacked record
+    a,b,c: byte;
+    d,e:0..15;
+    f: byte;
+    g: 0..$ffffff; { 3 bytes }
+    h: byte;
+  end;
+
+procedure p(var b: byte);
+begin
+  b := $12
+end;
+
+var
+  r: tr;
+begin
+  p(r.d);
+end.

tests/test/tprec17.pp

@@ -0,0 +1,23 @@
+{ %fail }
+
+type
+  trange = 0..$ffffff;
+
+  tr = bitpacked record
+    a,b,c: byte;
+    d,e:0..15;
+    f: byte;
+    g: trange; { 3 bytes }
+    h: byte;
+  end;
+
+procedure p(var b: trange);
+begin
+  b := $12
+end;
+
+var
+  r: tr;
+begin
+  p(r.g);
+end.

tests/test/tprec18.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+type
+  tr = bitpacked record
+    a,b,c: byte;
+    d,e:0..15;
+    f: byte;
+    g: 0..$ffffff; { 3 bytes }
+    h: byte;
+  end;
+
+procedure p(var b: byte);
+begin
+  b := $12
+end;
+
+var
+  r: tr;
+begin
+  p(r.e);
+end.