paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-26 16:33:45 +01:00
Code Issues Packages Projects Releases Wiki Activity

* forbid passing derived classes to call by reference parent classes (for objects, this is still allowed), resolves #13135

Browse Source 
git-svn-id: trunk@13551 -
This commit is contained in:
florian 2009-08-17 21:46:25 +00:00
parent e7c9a380f7
commit c0d4efed2e
11 changed files with 59 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9164,6 +9164,7 @@ tests/webtbs/tw13075.pp svneol=native#text/plain
tests/webtbs/tw1310.pp svneol=native#text/plain
tests/webtbs/tw13110.pp svneol=native#text/plain
tests/webtbs/tw13133.pp svneol=native#text/plain
tests/webtbs/tw13135.pp svneol=native#text/plain
tests/webtbs/tw1318.pp svneol=native#text/plain
tests/webtbs/tw13186.pp svneol=native#text/plain
tests/webtbs/tw13187.pp svneol=native#text/plain

16
compiler/htypechk.pas
View File

@ -503,7 +503,7 @@ implementation
{ Display info when multiple candidates are found }
candidates.dump_info(V_Debug);
{$endif EXTDEBUG}
cand_cnt:=candidates.choose_best(operpd,false);
cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
{ exit when no overloads are found }
if cand_cnt=0 then
@ -649,7 +649,7 @@ implementation
{ Display info when multiple candidates are found }
candidates.dump_info(V_Debug);
{$endif EXTDEBUG}
cand_cnt:=candidates.choose_best(operpd,false);
cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
{ exit when no overloads are found }
if cand_cnt=0 then
@ -1519,16 +1519,8 @@ implementation
{ if they are objects }
if (def_from.typ=objectdef) and
(
(
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)
)
(tobjectdef(def_from).objecttype=odt_object) and
(tobjectdef(def_to).objecttype=odt_object)
) and
(tobjectdef(def_from).is_related(tobjectdef(def_to))) then
eq:=te_convert_l1;

20
compiler/ncal.pas
View File

@ -738,7 +738,7 @@ implementation
{ release temp after next use }
addstatement(statements,ctempdeletenode.create_normal_temp(temp));
addstatement(statements,ctemprefnode.create(temp));
typecheckpass(block);
typecheckpass(tnode(block));
left:=block;
end;
@ -2842,13 +2842,13 @@ implementation
{ (simplify depends on typecheck info) }
if assigned(callinitblock) then
begin
typecheckpass(callinitblock);
dosimplify(callinitblock);
typecheckpass(tnode(callinitblock));
dosimplify(tnode(callinitblock));
end;
if assigned(callcleanupblock) then
begin
typecheckpass(callcleanupblock);
dosimplify(callcleanupblock);
typecheckpass(tnode(callcleanupblock));
dosimplify(tnode(callcleanupblock));
end;
{ Continue with checking a normal call or generate the inlined code }
@ -2885,7 +2885,7 @@ implementation
check_stack_parameters;
if assigned(callinitblock) then
firstpass(callinitblock);
firstpass(tnode(callinitblock));
{ function result node (tempref or simple load) }
if assigned(funcretnode) then
@ -2904,7 +2904,7 @@ implementation
firstpass(methodpointer);
if assigned(callcleanupblock) then
firstpass(callcleanupblock);
firstpass(tnode(callcleanupblock));
if not (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) then
include(current_procinfo.flags,pi_do_call);
@ -3358,9 +3358,9 @@ implementation
{ consider it must not be inlined if called
again inside the args or itself }
exclude(procdefinition.procoptions,po_inline);
typecheckpass(inlineblock);
dosimplify(inlineblock);
firstpass(inlineblock);
typecheckpass(tnode(inlineblock));
dosimplify(tnode(inlineblock));
firstpass(tnode(inlineblock));
include(procdefinition.procoptions,po_inline);
result:=inlineblock;

4
compiler/ncgcal.pas
View File

@ -935,7 +935,7 @@ implementation
internalerror(200305264);
if assigned(callinitblock) then
secondpass(callinitblock);
secondpass(tnode(callinitblock));
regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
@ -1203,7 +1203,7 @@ implementation
{ convert persistent temps for parameters and function result to normal temps }
if assigned(callcleanupblock) then
secondpass(callcleanupblock);
secondpass(tnode(callcleanupblock));
{ release temps and finalize unused return values, must be
after the callcleanupblock because that converts temps

6
compiler/ninl.pas
View File

@ -1062,9 +1062,9 @@ implementation
left := nil;
if is_typed then
found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),newstatement)
found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement))
else
found_error:=handle_text_read_write(filepara,Ttertiarynode(params),newstatement);
found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement));
{ if we found an error, simply delete the generated blocknode }
if found_error then
@ -2647,7 +2647,7 @@ implementation
if assigned(tempnode) then
addstatement(newstatement,ctempdeletenode.create(tempnode));
{ firstpass it }
firstpass(newblock);
firstpass(tnode(newblock));
{ return new node }
result := newblock;
end;

8
compiler/nutils.pas
View File

@ -115,10 +115,10 @@ implementation
end;
calln:
begin
result := foreachnode(procmethod,tcallnode(n).callinitblock,f,arg) or result;
result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
result := foreachnode(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
end;
ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
begin
@ -194,10 +194,10 @@ implementation
end;
calln:
begin
result := foreachnodestatic(procmethod,tcallnode(n).callinitblock,f,arg) or result;
result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
end;
ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
begin

6
compiler/optloop.pas
View File

@ -416,9 +416,9 @@ unit optloop;
{ clue everything together }
if assigned(initcode) then
begin
do_firstpass(initcode);
do_firstpass(calccode);
do_firstpass(deletecode);
do_firstpass(tnode(initcode));
do_firstpass(tnode(calccode));
do_firstpass(tnode(deletecode));
{ create a new for node, the old one will be released by the compiler }
with tfornode(node) do
begin

2
compiler/pstatmnt.pas
View File

@ -544,7 +544,7 @@ implementation
hdef:=tpointerdef.create(p.resultdef);
{ load address of the value in a temp }
tempnode:=ctempcreatenode.create_withnode(hdef,sizeof(pint),tt_persistent,true,p);
typecheckpass(tempnode);
typecheckpass(tnode(tempnode));
valuenode:=p;
refnode:=ctemprefnode.create(tempnode);
fillchar(refnode.fileinfo,sizeof(tfileposinfo),0);

2
compiler/psub.pas
View File

@ -616,7 +616,7 @@ implementation
addstatement(newstatement,bodyexitcode);
addstatement(newstatement,final_asmnode);
end;
do_firstpass(newblock);
do_firstpass(tnode(newblock));
code:=newblock;
current_filepos:=oldfilepos;
end;

12
packages/fcl-process/src/process.pp
View File

@ -178,9 +178,9 @@ end;
Procedure TProcess.FreeStreams;
begin
If FStderrStream<>FOutputStream then
FreeStream(FStderrStream);
FreeStream(FOutputStream);
FreeStream(FInputStream);
FreeStream(THandleStream(FStderrStream));
FreeStream(THandleStream(FOutputStream));
FreeStream(THandleStream(FInputStream));
end;
@ -221,17 +221,17 @@ end;
procedure TProcess.CloseInput;
begin
FreeStream(FInputStream);
FreeStream(THandleStream(FInputStream));
end;
procedure TProcess.CloseOutput;
begin
FreeStream(FOutputStream);
FreeStream(THandleStream(FOutputStream));
end;
procedure TProcess.CloseStderr;
begin
FreeStream(FStderrStream);
FreeStream(THandleStream(FStderrStream));
end;
Procedure TProcess.SetWindowColumns (Value : Cardinal);

22
tests/webtbs/tw13135.pp Normal file
View File

@ -0,0 +1,22 @@
{ %fail }
{$mode objfpc}
type
ta = class
end;
tb = class(ta)
end;
procedure test(var a: ta);
begin
a.free;
a:=ta.create;
// now b contains an instance of type "ta"
end;
var
b: tb;
begin
test(b);
end.