浏览代码

* perform typechecking of callinit/callcleanup statements immediately when
they are added (mantis #10807), because
a) the typecheckpass of the entire blocks has to be postponed until firstpass
because new statements may still be added in the firstpass (otherwise
the newly added statements in the firstpass are never typechecked due to
the blocknode already having a resultdef set)
b) simplify can be called between the typecheck and firstpass, and it needs
the typeinfo

git-svn-id: trunk@10263 -

Jonas Maebe 17 年之前
父节点
当前提交
59d9169bbd
共有 3 个文件被更改,包括 71 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 9 0
      compiler/ncal.pas
  3. 61 0
      tests/webtbs/tw10807.pp

+ 1 - 0
.gitattributes

@@ -7968,6 +7968,7 @@ tests/webtbs/tw10753a.pp svneol=native#text/plain
 tests/webtbs/tw10757.pp svneol=native#text/plain
 tests/webtbs/tw10790.pp svneol=native#text/plain
 tests/webtbs/tw10800.pp svneol=native#text/plain
+tests/webtbs/tw10807.pp svneol=native#text/plain
 tests/webtbs/tw1081.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain

+ 9 - 0
compiler/ncal.pas

@@ -1188,6 +1188,13 @@ implementation
           callinitblock:=internalstatements(lastinitstatement)
         else
           lastinitstatement:=laststatement(callinitblock);
+        { all these nodes must be immediately typechecked, because this routine }
+        { can be called from pass_1 (i.e., after typecheck has already run) and }
+        { moreover, the entire blocks themselves are also only typechecked in   }
+        { pass_1, while the the typeinfo is already required after the          }
+        { typecheck pass for simplify purposes (not yet perfect, because the    }
+        { statementnodes themselves are not typechecked this way)               }
+        typecheckpass(n);
         addstatement(lastinitstatement,n);
       end;
 
@@ -1200,6 +1207,8 @@ implementation
           callcleanupblock:=internalstatements(lastdonestatement)
         else
           lastdonestatement:=laststatement(callcleanupblock);
+        { see comments in add_init_statement }
+        typecheckpass(n);
         addstatement(lastdonestatement,n);
       end;
 

+ 61 - 0
tests/webtbs/tw10807.pp

@@ -0,0 +1,61 @@
+unit tw10807;
+
+interface
+{$mode delphi}
+
+uses
+  Classes, SysUtils;
+
+const maxword = 65535;
+
+type
+  PClrStreamHeader = ^TClrStreamHeader;
+  TClrStreamHeader = packed record
+    Name: array [0..MaxWord] of Char;
+  end;
+  TJclClrStream = class(TObject)
+   constructor Create(const AMetadata: Tobject;      AHeader: PClrStreamHeader); virtual;
+    end;
+   TJclClrStreamClass = class of TJclClrStream;
+
+  tobjectlist = class
+    procedure add(c: tobject);
+  end;
+
+  tJclPeImage=class(tobject)
+               end;
+  TJclPeMetadata = class(TObject)
+  private
+    FStreams: TObjectList;
+    constructor Create(const AImage: TJclPeImage);
+  end;
+
+implementation
+
+procedure tobjectlist.add(c: tobject);
+begin
+end;
+
+constructor TJclPeMetadata.Create(const AImage: TJclPeImage);
+
+  function GetStreamClass(const Name: string): TJclClrStreamClass;
+  begin
+  end;
+
+  procedure UpdateStreams;
+  var
+    pStream: PClrStreamHeader;
+    I: Integer;
+  begin
+     FStreams.Add(GetStreamClass(pStream.Name).Create(Self, pStream));
+  end;
+
+begin
+end;
+
+constructor TJclClrStream.Create(const AMetadata: Tobject;      AHeader: PClrStreamHeader);
+begin
+end;
+
+end.
+