paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-09 19:57:20 +01:00
Code Issues Packages Projects Releases Wiki Activity

- removed "do_count" parameter from tcallparanode.insert_typeconv

Browse Source 
because the method was always called the same way (and it did not
    affect any counting anymore)
  * fixed and simplified read/write checking of methodpointer (mantis
    #10736)

git-svn-id: trunk@10155 -
This commit is contained in:
Jonas Maebe 2008-02-02 16:34:48 +00:00
parent cc710dc05f
commit 3521d64f4b
3 changed files with 83 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7915,6 +7915,7 @@ tests/webtbs/tw1068.pp svneol=native#text/plain
tests/webtbs/tw10681.pp svneol=native#text/plain
tests/webtbs/tw1071.pp svneol=native#text/plain
tests/webtbs/tw1073.pp svneol=native#text/plain
tests/webtbs/tw10736.pp svneol=native#text/plain
tests/webtbs/tw1081.pp svneol=native#text/plain
tests/webtbs/tw1090.pp svneol=native#text/plain
tests/webtbs/tw1092.pp svneol=native#text/plain

43
compiler/ncal.pas
View File

@ -172,7 +172,7 @@ interface
function pass_1 : tnode;override;
procedure get_paratype;
procedure firstcallparan;
procedure insert_typeconv(do_count : boolean);
procedure insert_typeconv;
procedure secondcallparan;virtual;abstract;
function docompare(p: tnode): boolean; override;
procedure printnodetree(var t:text);override;
@ -584,7 +584,7 @@ implementation
end;
procedure tcallparanode.insert_typeconv(do_count : boolean);
procedure tcallparanode.insert_typeconv;
var
olddef : tdef;
hp : tnode;
@ -807,21 +807,18 @@ implementation
else
make_not_regable(left,[ra_addr_regable]);
if do_count then
begin
case parasym.varspez of
vs_out :
begin
{ first set written separately to avoid false }
{ uninitialized warnings (tbs/tb0542) }
set_varstate(left,vs_written,[]);
set_varstate(left,vs_readwritten,[]);
end;
vs_var :
set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
else
set_varstate(left,vs_read,[vsf_must_be_valid]);
end;
case parasym.varspez of
vs_out :
begin
{ first set written separately to avoid false }
{ uninitialized warnings (tbs/tb0542) }
set_varstate(left,vs_written,[]);
set_varstate(left,vs_readwritten,[]);
end;
vs_var :
set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
else
set_varstate(left,vs_read,[vsf_must_be_valid]);
end;
{ must only be done after typeconv PM }
resultdef:=parasym.vardef;
@ -830,7 +827,7 @@ implementation
{ process next node }
if assigned(right) then
tcallparanode(right).insert_typeconv(do_count);
tcallparanode(right).insert_typeconv;
end;
@ -2418,16 +2415,8 @@ implementation
{ a constructor will and a method may write something to }
{ the fields }
set_varstate(methodpointer,vs_readwritten,[])
else if ((hpt.nodetype=loadn) and
(methodpointer.resultdef.typ=classrefdef)) then
set_varstate(methodpointer,vs_read,[])
else
set_varstate(methodpointer,vs_read,[vsf_must_be_valid]);
{ The object is already used if it is called once }
if (hpt.nodetype=loadn) and
(tloadnode(hpt).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) then
set_varstate(hpt,vs_read,[]);
end;
{ if we are calling the constructor check for abstract
@ -2462,7 +2451,7 @@ implementation
{ insert type conversions for parameters }
if assigned(left) then
tcallparanode(left).insert_typeconv(true);
tcallparanode(left).insert_typeconv;
{ dispinterface methode invoke? }
if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then

66
tests/webtbs/tw10736.pp Normal file
View File

@ -0,0 +1,66 @@
{ %OPT=-Sew }
unit tw10736;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TAbstractPage }
TAbstractPage = class
protected
procedure Execute virtual; abstract;
public
class procedure PageExecute;
end;
TPageClass = class of TAbstractPage;
{ TPageUnknown }
TPageUnknown = class(TAbstractPage)
protected
procedure Execute override;
end;
procedure HandleRequest;
implementation
{ TAbstractPage }
class procedure TAbstractPage.PageExecute;
begin
(*
with Self.Create do try
Execute;
finally
Free;
end;
*)
end;
{ TPageUnknown }
procedure TPageUnknown.Execute;
begin
//Whatever...
end;
procedure HandleRequest;
//Zomaar een kleine besturing, iemand andere ideen?
var Page: TPageClass;
begin
Page := TPageUnknown;
Page.PageExecute;
end;
end.