mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:26:15 +02:00
- revert fix for #10927: the old behaviour was Delphi compatible,
and the fix caused other problems (#10979) git-svn-id: trunk@10464 -
This commit is contained in:
parent
48fb130be3
commit
8adc596c16
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8013,6 +8013,7 @@ tests/webtbs/tw10931.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw1096.pp svneol=native#text/plain
|
tests/webtbs/tw1096.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw10966.pp svneol=native#text/plain
|
tests/webtbs/tw10966.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1097.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/tw1103.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1104.pp svneol=native#text/plain
|
tests/webtbs/tw1104.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1111.pp svneol=native#text/plain
|
tests/webtbs/tw1111.pp svneol=native#text/plain
|
||||||
|
@ -1062,21 +1062,6 @@ implementation
|
|||||||
fieldvarsym :
|
fieldvarsym :
|
||||||
begin
|
begin
|
||||||
{ generate access code }
|
{ 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);
|
propaccesslist_to_node(p1,st,propaccesslist);
|
||||||
include(p1.flags,nf_isproperty);
|
include(p1.flags,nf_isproperty);
|
||||||
consume(_ASSIGNMENT);
|
consume(_ASSIGNMENT);
|
||||||
@ -1105,15 +1090,6 @@ implementation
|
|||||||
fieldvarsym :
|
fieldvarsym :
|
||||||
begin
|
begin
|
||||||
{ generate access code }
|
{ 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);
|
propaccesslist_to_node(p1,st,propaccesslist);
|
||||||
include(p1.flags,nf_isproperty);
|
include(p1.flags,nf_isproperty);
|
||||||
end;
|
end;
|
||||||
@ -2258,14 +2234,14 @@ implementation
|
|||||||
not from self }
|
not from self }
|
||||||
if srsym.typ in [procsym,propertysym] then
|
if srsym.typ in [procsym,propertysym] then
|
||||||
begin
|
begin
|
||||||
hdef:=hclassdef;
|
|
||||||
if (srsym.typ = procsym) then
|
if (srsym.typ = procsym) then
|
||||||
begin
|
begin
|
||||||
|
hdef:=hclassdef;
|
||||||
if (po_classmethod in current_procinfo.procdef.procoptions) or
|
if (po_classmethod in current_procinfo.procdef.procoptions) or
|
||||||
(po_staticmethod in current_procinfo.procdef.procoptions) then
|
(po_staticmethod in current_procinfo.procdef.procoptions) then
|
||||||
hdef:=tclassrefdef.create(hdef);
|
hdef:=tclassrefdef.create(hdef);
|
||||||
|
p1:=ctypenode.create(hdef);
|
||||||
end;
|
end;
|
||||||
p1:=ctypenode.create(hdef);
|
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
{ %result=1 }
|
||||||
|
|
||||||
program project1;
|
program project1;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
43
tests/webtbs/tw10979.pp
Normal file
43
tests/webtbs/tw10979.pp
Normal 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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user