* don't allow taking the address of ordinal bitpacked array elements

    whose size is not a power of two
  + some more packed array/record tests

git-svn-id: trunk@7610 -

.gitattributes

@@ -6909,6 +6909,10 @@ tests/test/tparray19.pp svneol=native#text/plain
 tests/test/tparray2.pp svneol=native#text/plain
 tests/test/tparray20.pp svneol=native#text/plain
 tests/test/tparray21.pp svneol=native#text/plain
+tests/test/tparray22.pp svneol=native#text/plain
+tests/test/tparray23.pp svneol=native#text/plain
+tests/test/tparray24.pp svneol=native#text/plain
+tests/test/tparray25.pp svneol=native#text/plain
 tests/test/tparray3.pp svneol=native#text/plain
 tests/test/tparray4.pp svneol=native#text/plain
 tests/test/tparray5.pp svneol=native#text/plain
@@ -6927,7 +6931,9 @@ 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/tprec19.pp svneol=native#text/plain
 tests/test/tprec2.pp svneol=native#text/plain
+tests/test/tprec20.pp svneol=native#text/plain
 tests/test/tprec3.pp svneol=native#text/plain
 tests/test/tprec4.pp svneol=native#text/plain
 tests/test/tprec5.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -1115,7 +1115,9 @@ implementation
                     not(valid_packed in opts) and
                     (tvecnode(hp).left.resultdef.typ = arraydef) and
                     (ado_IsBitPacked in tarraydef(tvecnode(hp).left.resultdef).arrayoptions) and
-                    (tarraydef(tvecnode(hp).left.resultdef).elepackedbitsize mod 8 <> 0) then
+                    ((tarraydef(tvecnode(hp).left.resultdef).elepackedbitsize mod 8 <> 0) or
+                     (is_ordinal(tarraydef(tvecnode(hp).left.resultdef).elementdef) and
+                      not ispowerof2(tarraydef(tvecnode(hp).left.resultdef).elepackedbitsize div 8,temp))) then
                    begin
                      if report_errors then
                        if (valid_property in opts) then

tests/test/tparray22.pp

@@ -0,0 +1,16 @@
+{ %fail }
+
+type
+  trange = 0..$ffffff;
+  tarr = bitpacked array[0..20] of trange;
+
+procedure p(var a: trange);
+begin
+end;
+
+var
+  a: tarr;
+begin
+  a[0]:=5;
+  p(a[0]);
+end.

tests/test/tparray23.pp

@@ -0,0 +1,17 @@
+{ %fail }
+
+type
+  trange = 0..$ffffff;
+  prange = ^trange;
+  tarr = bitpacked array[0..20] of trange;
+
+procedure p(a: prange);
+begin
+end;
+
+var
+  a: tarr;
+begin
+  a[0]:=5;
+  p(@a[0]);
+end.

tests/test/tparray24.pp

@@ -0,0 +1,17 @@
+type
+  tstr = string[2];
+  tarr = bitpacked array[0..20] of tstr;
+
+procedure p(var a: tstr);
+begin
+  a := 'ab';
+end;
+
+var
+  a: tarr;
+begin
+  a[0]:='gh';
+  p(a[0]);
+  if (a[0]<>'ab') then
+    halt(1);
+end.

tests/test/tparray25.pp

@@ -0,0 +1,18 @@
+type
+  tstr = string[2];
+  pstr = ^tstr;
+  tarr = bitpacked array[0..20] of tstr;
+
+procedure p(a: pstr);
+begin
+  a^ := 'ab';
+end;
+
+var
+  a: tarr;
+begin
+  a[0]:='gh';
+  p(@a[0]);
+  if (a[0]<>'ab') then
+    halt(1);
+end.

tests/test/tprec19.pp

@@ -0,0 +1,44 @@
+type
+  pbyte = ^byte;
+
+  tr = bitpacked record
+    a,b,c: byte;
+    d,e:0..15;
+    f: byte;
+    g: 0..$ffffff; { 3 bytes }
+    h: byte;
+  end;
+
+procedure p(b: pbyte);
+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/tprec20.pp

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