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

- revert fix for #10927: the old behaviour was Delphi compatible,

Browse Source 
and the fix caused other problems (#10979)

git-svn-id: trunk@10464 -
This commit is contained in:
Jonas Maebe 2008-03-08 18:17:31 +00:00
parent 48fb130be3
commit 8adc596c16
4 changed files with 48 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8013,6 +8013,7 @@ tests/webtbs/tw10931.pp svneol=native#text/plain
tests/webtbs/tw1096.pp svneol=native#text/plain
tests/webtbs/tw10966.pp svneol=native#text/plain
tests/webtbs/tw1097.pp svneol=native#text/plain
tests/webtbs/tw10979.pp svneol=native#text/plain
tests/webtbs/tw1103.pp svneol=native#text/plain
tests/webtbs/tw1104.pp svneol=native#text/plain
tests/webtbs/tw1111.pp svneol=native#text/plain

28
compiler/pexpr.pas
View File

@ -1062,21 +1062,6 @@ implementation
fieldvarsym :
begin
{ generate access code }
{ for fieldvars, having a typenode is wrong: }
{ fields cannot be overridden/hidden in child }
{ classes. However, we always have to pass the }
{ typenode to handle_propertysym because the }
{ parent doesn't know yet to what the property }
{ will resolve (and in case of procsyms, we do }
{ need the type node in case of }
{ "inherited property_with_getter/setter" }
if (assigned(p1)) and
(p1.nodetype = typen) then
begin
p1.free;
p1:=nil;
end;
propaccesslist_to_node(p1,st,propaccesslist);
include(p1.flags,nf_isproperty);
consume(_ASSIGNMENT);
@ -1105,15 +1090,6 @@ implementation
fieldvarsym :
begin
{ generate access code }
{ for fieldvars, having a typenode is wrong: }
{ see comments above for write access }
if (assigned(p1)) and
(p1.nodetype = typen) then
begin
p1.free;
p1:=nil;
end;
propaccesslist_to_node(p1,st,propaccesslist);
include(p1.flags,nf_isproperty);
end;
@ -2258,14 +2234,14 @@ implementation
not from self }
if srsym.typ in [procsym,propertysym] then
begin
hdef:=hclassdef;
if (srsym.typ = procsym) then
begin
hdef:=hclassdef;
if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then
hdef:=tclassrefdef.create(hdef);
p1:=ctypenode.create(hdef);
end;
p1:=ctypenode.create(hdef);
end
else
begin

2
tests/webtbs/tw10927.pp
View File

@ -1,3 +1,5 @@
{ %result=1 }
program project1;
{$mode objfpc}{$H+}

43
tests/webtbs/tw10979.pp Normal file
View File

@ -0,0 +1,43 @@
{$ifdef fpc}
{$mode objfpc}
{$endif fpc}
uses Classes;
{$ifndef fpc}
type
ptruint = cardinal;
{$endif}
type
TMyStringList = class(TStringList)
private
function GetObjects(Index: Integer): TStringList;
procedure SetObjects(Index: Integer; const Value: TStringList);
public
property Objects[Index: Integer]: TStringList read GetObjects write SetObjects;
end;
function TMyStringList.GetObjects(Index: Integer): TStringList;
begin
Result := TStringList(inherited Objects[Index]);
end;
procedure TMyStringList.SetObjects(Index: Integer; const Value: TStringList);
begin
writeln('setobjects called');
inherited Objects[Index] := Value;
end;
var
SL: TMyStringList;
begin
SL := TMyStringList.Create;
SL.AddObject('Hello',SL);
WriteLn(SL[0],':',PtrUint(SL.Objects[0]),':',PtrUint(SL));
if (sl[0]<>'Hello') or
(PtrUint(SL.Objects[0])<>PtrUint(SL)) then
halt(1);
end.