ソースを参照

compiler: treat record/class fields types as bt_var_type block in delphi mode - as result they don't create a forward declaration for ^Type. Leave it as is for other modes because in other case it break the compilation of RTL and packages (fixes issue #0018620)

git-svn-id: trunk@16832 -
paul 14 年 前
コミット
e77a9051c8
4 ファイル変更51 行追加1 行削除
  1. 2 0
      .gitattributes
  2. 19 1
      compiler/pdecvar.pas
  3. 14 0
      tests/webtbf/tw18620.pp
  4. 16 0
      tests/webtbs/tw18620.pp

+ 2 - 0
.gitattributes

@@ -10149,6 +10149,7 @@ tests/webtbf/tw1827.pp svneol=native#text/plain
 tests/webtbf/tw1830.pp svneol=native#text/plain
 tests/webtbf/tw1830.pp svneol=native#text/plain
 tests/webtbf/tw1842.pp svneol=native#text/plain
 tests/webtbf/tw1842.pp svneol=native#text/plain
 tests/webtbf/tw1858.pp svneol=native#text/plain
 tests/webtbf/tw1858.pp svneol=native#text/plain
+tests/webtbf/tw18620.pp svneol=native#text/pascal
 tests/webtbf/tw1905.pp svneol=native#text/plain
 tests/webtbf/tw1905.pp svneol=native#text/plain
 tests/webtbf/tw1927.pp svneol=native#text/plain
 tests/webtbf/tw1927.pp svneol=native#text/plain
 tests/webtbf/tw1928.pp svneol=native#text/plain
 tests/webtbf/tw1928.pp svneol=native#text/plain
@@ -10961,6 +10962,7 @@ tests/webtbs/tw1856.pp svneol=native#text/plain
 tests/webtbs/tw18567 svneol=native#text/pascal
 tests/webtbs/tw18567 svneol=native#text/pascal
 tests/webtbs/tw18610.pp svneol=native#text/pascal
 tests/webtbs/tw18610.pp svneol=native#text/pascal
 tests/webtbs/tw1862.pp svneol=native#text/plain
 tests/webtbs/tw1862.pp svneol=native#text/plain
+tests/webtbs/tw18620.pp svneol=native#text/pascal
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain

+ 19 - 1
compiler/pdecvar.pas

@@ -1441,8 +1441,11 @@ implementation
          tempdef: tdef;
          tempdef: tdef;
          is_first_type: boolean;
          is_first_type: boolean;
 {$endif powerpc or powerpc64}
 {$endif powerpc or powerpc64}
-         sl       : tpropaccesslist;
+         sl: tpropaccesslist;
+         old_block_type: tblock_type;
       begin
       begin
+         old_block_type:=block_type;
+         block_type:=bt_var;
          recst:=tabstractrecordsymtable(symtablestack.top);
          recst:=tabstractrecordsymtable(symtablestack.top);
 {$if defined(powerpc) or defined(powerpc64)}
 {$if defined(powerpc) or defined(powerpc64)}
          is_first_type:=true;
          is_first_type:=true;
@@ -1471,6 +1474,10 @@ implementation
                  end;
                  end;
                consume(_ID);
                consume(_ID);
              until not try_to_consume(_COMMA);
              until not try_to_consume(_COMMA);
+             if m_delphi in current_settings.modeswitches then
+               block_type:=bt_var_type
+             else
+               block_type:=old_block_type;
              consume(_COLON);
              consume(_COLON);
 
 
              { Don't search for types where they can't be:
              { Don't search for types where they can't be:
@@ -1484,6 +1491,7 @@ implementation
                  symtablestack.pop(recst);
                  symtablestack.pop(recst);
                end;
                end;
              read_anon_type(hdef,false);
              read_anon_type(hdef,false);
+             block_type:=bt_var;
              { allow only static fields reference to struct where they are declared }
              { allow only static fields reference to struct where they are declared }
              if not (vd_class in options) and
              if not (vd_class in options) and
                (is_object(hdef) or is_record(hdef)) and
                (is_object(hdef) or is_record(hdef)) and
@@ -1630,6 +1638,10 @@ implementation
            end;
            end;
           recstlist.free;
           recstlist.free;
 
 
+         if m_delphi in current_settings.modeswitches then
+           block_type:=bt_var_type
+         else
+           block_type:=old_block_type;
          { Check for Case }
          { Check for Case }
          if (vd_record in options) and
          if (vd_record in options) and
             try_to_consume(_CASE) then
             try_to_consume(_CASE) then
@@ -1650,6 +1662,7 @@ implementation
                   symtablestack.top.insert(fieldvs);
                   symtablestack.top.insert(fieldvs);
                 end;
                 end;
               read_anon_type(casetype,true);
               read_anon_type(casetype,true);
+              block_type:=bt_var;
               if assigned(fieldvs) then
               if assigned(fieldvs) then
                 begin
                 begin
                   fieldvs.vardef:=casetype;
                   fieldvs.vardef:=casetype;
@@ -1685,6 +1698,10 @@ implementation
                   else
                   else
                     break;
                     break;
                 until false;
                 until false;
+                if m_delphi in current_settings.modeswitches then
+                  block_type:=bt_var_type
+                else
+                  block_type:=old_block_type;
                 consume(_COLON);
                 consume(_COLON);
                 { read the vars }
                 { read the vars }
                 consume(_LKLAMMER);
                 consume(_LKLAMMER);
@@ -1750,6 +1767,7 @@ implementation
 {$ifdef powerpc}
 {$ifdef powerpc}
          is_first_type := false;
          is_first_type := false;
 {$endif powerpc}
 {$endif powerpc}
+         block_type:=old_block_type;
       end;
       end;
 
 
 end.
 end.

+ 14 - 0
tests/webtbf/tw18620.pp

@@ -0,0 +1,14 @@
+{ %fail }
+program tw18620;
+{$mode delphi}
+
+type
+  { in mode delphi compiler should not create a forward definistion for ^_TFoo for later resolve
+    instead it must search _TFoo amoung already defined symbols }
+  TFoo = record
+    Foo: ^_TFoo;
+  end;
+  _TFoo = TFoo;
+
+begin
+end.

+ 16 - 0
tests/webtbs/tw18620.pp

@@ -0,0 +1,16 @@
+program tw18620;
+{$mode Delphi}
+
+{ in delphi mode ^T in the var block of class/record/object should not create
+  a forward definition which must be resolved after the type section end      }
+
+type 
+  C = class
+    type 
+      T = integer;
+    var 
+      V: ^T;
+  end;
+
+begin
+end.