Browse Source

* don't allow taking the address of packed record fields
* don't allow using packed record fields as loopvars

git-svn-id: trunk@4509 -

Jonas Maebe 19 years ago
parent
commit
340e2257f3
4 changed files with 39 additions and 0 deletions
  1. 2 0
      .gitattributes
  2. 9 0
      compiler/htypechk.pas
  3. 15 0
      tests/test/tprec10.pp
  4. 13 0
      tests/test/tprec9.pp

+ 2 - 0
.gitattributes

@@ -6153,6 +6153,7 @@ tests/test/tparray8.pp svneol=native#text/plain
 tests/test/tparray9.pp svneol=native#text/plain
 tests/test/tparray9.pp svneol=native#text/plain
 tests/test/tpftch1.pp svneol=native#text/plain
 tests/test/tpftch1.pp svneol=native#text/plain
 tests/test/tprec1.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/tprec2.pp svneol=native#text/plain
 tests/test/tprec3.pp svneol=native#text/plain
 tests/test/tprec3.pp svneol=native#text/plain
 tests/test/tprec4.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/tprec6.pp svneol=native#text/plain
 tests/test/tprec7.pp svneol=native#text/plain
 tests/test/tprec7.pp svneol=native#text/plain
 tests/test/tprec8.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/tprocext.pp svneol=native#text/plain
 tests/test/tprocvar1.pp svneol=native#text/plain
 tests/test/tprocvar1.pp svneol=native#text/plain
 tests/test/tprocvar2.pp svneol=native#text/plain
 tests/test/tprocvar2.pp svneol=native#text/plain

+ 9 - 0
compiler/htypechk.pas

@@ -1087,6 +1087,15 @@ implementation
                end;
                end;
              subscriptn :
              subscriptn :
                begin
                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;
                  gotsubscript:=true;
                  { loop counter? }
                  { loop counter? }
                  if not(Valid_Const in opts) and
                  if not(Valid_Const in opts) and

+ 15 - 0
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.

+ 13 - 0
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.