summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-08-17 21:46:25 +0000
committerflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-08-17 21:46:25 +0000
commitb2de7b32771e376b7041c0e4b4f3fdbdeafff01e (patch)
treeece38ea9b33e6e299f44d100d84a92ec22678ea2
parent9c94b6f0c13e3f7fec1fb2894f55cd0cea8a1af1 (diff)
downloadfpc-b2de7b32771e376b7041c0e4b4f3fdbdeafff01e.tar.gz
* forbid passing derived classes to call by reference parent classes (for objects, this is still allowed), resolves #13135
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@13551 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--compiler/htypechk.pas16
-rw-r--r--compiler/ncal.pas20
-rw-r--r--compiler/ncgcal.pas4
-rw-r--r--compiler/ninl.pas6
-rw-r--r--compiler/nutils.pas8
-rw-r--r--compiler/optloop.pas6
-rw-r--r--compiler/pstatmnt.pas2
-rw-r--r--compiler/psub.pas2
-rw-r--r--packages/fcl-process/src/process.pp16
-rw-r--r--tests/webtbs/tw13135.pp22
10 files changed, 58 insertions, 44 deletions
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index eed7f32ebd..9ad3c23ec2 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -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;
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 1ff63927fb..196e051e2f 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -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;
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index 92e92a5713..8a05013254 100644
--- a/compiler/ncgcal.pas
+++ b/compiler/ncgcal.pas
@@ -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
diff --git a/compiler/ninl.pas b/compiler/ninl.pas
index c6568ba9fb..9b111445cd 100644
--- a/compiler/ninl.pas
+++ b/compiler/ninl.pas
@@ -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;
diff --git a/compiler/nutils.pas b/compiler/nutils.pas
index 9f87a0dd79..d8ca2f9db5 100644
--- a/compiler/nutils.pas
+++ b/compiler/nutils.pas
@@ -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
diff --git a/compiler/optloop.pas b/compiler/optloop.pas
index 3ffa1f15c1..c535f49585 100644
--- a/compiler/optloop.pas
+++ b/compiler/optloop.pas
@@ -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
diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index b96184a9d0..80d3dd7180 100644
--- a/compiler/pstatmnt.pas
+++ b/compiler/pstatmnt.pas
@@ -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);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index d4e69b72d7..be3525783c 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -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;
diff --git a/packages/fcl-process/src/process.pp b/packages/fcl-process/src/process.pp
index 10f94ba811..fd51639424 100644
--- a/packages/fcl-process/src/process.pp
+++ b/packages/fcl-process/src/process.pp
@@ -82,7 +82,7 @@ Type
procedure SetActive(const Value: Boolean);
procedure SetEnvironment(const Value: TStrings);
function PeekExitStatus: Boolean;
- Protected
+ Protected
FRunning : Boolean;
FExitCode : Cardinal;
FInputStream : TOutputPipeStream;
@@ -134,7 +134,7 @@ Type
Property WindowWidth : Cardinal Read dwXSize Write SetWindowWidth;
Property FillAttribute : Cardinal read FFillAttribute Write FFillAttribute;
end;
-
+
EProcess = Class(Exception);
implementation
@@ -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);
diff --git a/tests/webtbs/tw13135.pp b/tests/webtbs/tw13135.pp
new file mode 100644
index 0000000000..c7197a73ac
--- /dev/null
+++ b/tests/webtbs/tw13135.pp
@@ -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. \ No newline at end of file