Răsfoiți Sursa

* disallow passing descendent interfaces to var parameters (mantis #12933)

git-svn-id: trunk@12535 -
Jonas Maebe 16 ani în urmă
părinte
comite
8ad1500438
3 a modificat fișierele cu 27 adăugiri și 1 ștergeri
  1. 1 0
      .gitattributes
  2. 6 1
      compiler/htypechk.pas
  3. 20 0
      tests/webtbf/tw12933.pp

+ 1 - 0
.gitattributes

@@ -8228,6 +8228,7 @@ tests/webtbf/tw12365b.pp svneol=native#text/plain
 tests/webtbf/tw1238.pp svneol=native#text/plain
 tests/webtbf/tw1251a.pp svneol=native#text/plain
 tests/webtbf/tw1270.pp svneol=native#text/plain
+tests/webtbf/tw12933.pp svneol=native#text/plain
 tests/webtbf/tw1306.pp svneol=native#text/plain
 tests/webtbf/tw1316.pp svneol=native#text/plain
 tests/webtbf/tw1328.pp svneol=native#text/plain

+ 6 - 1
compiler/htypechk.pas

@@ -1495,8 +1495,13 @@ implementation
               { if they are objects              }
               if (def_from.typ=objectdef) and
                  (
-                  not(m_delphi in current_settings.modeswitches) or
                   (
+                   not(m_delphi in current_settings.modeswitches) and
+                   (tobjectdef(def_from).objecttype in [odt_object,odt_class]) and
+                   (tobjectdef(def_to).objecttype in [odt_object,odt_class])
+                  ) or
+                  (
+                   (m_delphi in current_settings.modeswitches) and
                    (tobjectdef(def_from).objecttype=odt_object) and
                    (tobjectdef(def_to).objecttype=odt_object)
                   )

+ 20 - 0
tests/webtbf/tw12933.pp

@@ -0,0 +1,20 @@
+{ %fail }
+
+{$mode objfpc}
+
+type
+  ta = interface
+  end;
+
+  tb = interface(ta)
+  end;
+
+procedure test(var a: ta);
+begin
+end;
+
+var
+  b: tb;
+begin
+  test(b);
+end.