paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* support indexed stored methods

Browse Source 
git-svn-id: trunk@4740 -
This commit is contained in:
peter 2006-09-27 18:32:18 +00:00
parent d4fa2100ce
commit 2c7bc12ad6
4 changed files with 50 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7338,6 +7338,7 @@ tests/webtbs/tw7227.pp svneol=native#text/plain
tests/webtbs/tw7276.pp svneol=native#text/plain
tests/webtbs/tw7372.pp svneol=native#text/plain
tests/webtbs/tw7379.pp svneol=native#text/plain
tests/webtbs/tw7391.pp svneol=native#text/plain
tests/webtbs/tw7425.pp svneol=native#text/plain
tests/webtbs/tw7440.pp svneol=native#text/plain
tests/webtbs/tw7446.pp svneol=native#text/plain

14
compiler/pdecvar.pas
View File

@ -224,6 +224,7 @@ implementation
intfidx: longint;
hreadparavs,
hparavs : tparavarsym;
storedprocdef,
readprocdef,
writeprocdef : tprocvardef;
begin
@ -232,14 +233,19 @@ implementation
paranr:=0;
readprocdef:=tprocvardef.create(normal_function_level);
writeprocdef:=tprocvardef.create(normal_function_level);
storedprocdef:=tprocvardef.create(normal_function_level);
{ make it method pointers }
if assigned(aclass) then
begin
include(readprocdef.procoptions,po_methodpointer);
include(writeprocdef.procoptions,po_methodpointer);
include(storedprocdef.procoptions,po_methodpointer);
end;
{ method for stored must return boolean }
storedprocdef.rettype:=booltype;
if token<>_ID then
begin
consume(_ID);
@ -351,6 +357,8 @@ implementation
readprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype,[]);
writeprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype,[]);
storedprocdef.parast.insert(hparavs);
pt.free;
end;
end
@ -505,7 +513,9 @@ implementation
case sym.typ of
procsym :
begin
p.storedaccess.procdef:=Tprocsym(sym).search_procdef_nopara_boolret;
{ Insert hidden parameters }
handle_calling_convention(storedprocdef);
p.storedaccess.procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.rettype.def,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.storedaccess.procdef) then
message(parser_e_ill_property_storage_sym);
end;
@ -623,7 +633,7 @@ implementation
end;
end;
end;
{ remove temporary procvardefs }
readprocdef.free;
writeprocdef.free;

20
compiler/symsym.pas
View File

@ -108,7 +108,6 @@ interface
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
function first_procdef:Tprocdef;
function last_procdef:Tprocdef;
function search_procdef_nopara_boolret:Tprocdef;
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
@ -812,25 +811,6 @@ implementation
end;
function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
var
p : pprocdeflist;
begin
search_procdef_nopara_boolret:=nil;
p:=pdlistfirst;
while p<>nil do
begin
if (p^.def.maxparacount=0) and
is_boolean(p^.def.rettype.def) then
begin
search_procdef_nopara_boolret:=p^.def;
break;
end;
p:=p^.next;
end;
end;
function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
var
p : pprocdeflist;

37
tests/webtbs/tw7391.pp Executable file
View File

@ -0,0 +1,37 @@
{$Ifdef fpc}{$mode objfpc}{$h+}{$endif}
uses
Classes;
type
TGLNode = class (TCollectionItem)
private
FCoords : array[0..2] of Byte;
procedure SetCoordinate(Indx: Integer; AValue: Byte);
protected
function StoreCoordinate(Indx: Integer) : Boolean;
published
property X: Byte index 0 read FCoords[0] write SetCoordinate stored StoreCoordinate;
property Y: Byte index 1 read FCoords[1] write SetCoordinate stored StoreCoordinate;
property Z: Byte index 2 read FCoords[2] write SetCoordinate stored StoreCoordinate;
end;
{ TGLNode }
procedure TGLNode.SetCoordinate(Indx: Integer; AValue: Byte);
begin
FCoords[Indx]:=AValue;
end;
function TGLNode.StoreCoordinate(Indx: Integer): Boolean;
begin
result:=(FCoords[Indx] <> 0);
end;
var
n : TGLNode;
begin
n:=TGLNode.Create(nil);
n.X:=1;
n.Y:=2;
n.Z:=3;
writeln(n.X,',',n.Y,',',n.Z);
end.