* disallow passing descendent interfaces to var parameters (mantis )

git-svn-id: trunk@12535 -
This commit is contained in:
Jonas Maebe 2009-01-10 19:47:52 +00:00
parent 3a68484434
commit 8ad1500438
3 changed files with 27 additions and 1 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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
tests/webtbf/tw12933.pp Normal file
View File

@ -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.