瀏覽代碼

* fix for Mantis #38771: the owner of the procdef might be Nil in case of a specialization (that virtual can't be used on generics is caught later on)
+ added test

git-svn-id: trunk@49228 -

svenbarth 4 年之前
父節點
當前提交
f9957f30a5
共有 3 個文件被更改,包括 25 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 2 1
      compiler/pdecsub.pas
  3. 22 0
      tests/webtbf/tw38771.pp

+ 1 - 0
.gitattributes

@@ -16821,6 +16821,7 @@ tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw38439.pp svneol=native#text/pascal
 tests/webtbf/tw38439.pp svneol=native#text/pascal
 tests/webtbf/tw38504.pp svneol=native#text/pascal
 tests/webtbf/tw38504.pp svneol=native#text/pascal
 tests/webtbf/tw38504b.pp svneol=native#text/pascal
 tests/webtbf/tw38504b.pp svneol=native#text/pascal
+tests/webtbf/tw38771.pp svneol=native#text/pascal
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain

+ 2 - 1
compiler/pdecsub.pas

@@ -1959,7 +1959,8 @@ var
   pt : tnode;
   pt : tnode;
 {$endif WITHDMT}
 {$endif WITHDMT}
 begin
 begin
-  if (not assigned(pd.owner.defowner) or
+  if assigned(pd.owner) and
+     (not assigned(pd.owner.defowner) or
       not is_java_class_or_interface(tdef(pd.owner.defowner))) and
       not is_java_class_or_interface(tdef(pd.owner.defowner))) and
      (po_external in pd.procoptions) then
      (po_external in pd.procoptions) then
     Message2(parser_e_proc_dir_conflict,'EXTERNAL','"VIRTUAL"');
     Message2(parser_e_proc_dir_conflict,'EXTERNAL','"VIRTUAL"');

+ 22 - 0
tests/webtbf/tw38771.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+{$mode objfpc}
+
+program tw38771;
+
+type
+  TMyClass = class
+    generic procedure DoThis<T>(msg: T);
+    generic procedure DoThat<T>(msg: T); virtual;
+  end;
+
+generic procedure TMyClass.DoThis<T>(msg:T);
+begin
+  specialize DoThat<T>(msg);
+end;
+
+generic procedure TMyClass.DoThat<T>(msg: T);
+begin
+end;
+
+begin
+end.