diff --git a/.gitattributes b/.gitattributes index 2ae6ca038d..26078606a7 100644 --- a/.gitattributes +++ b/.gitattributes @@ -11005,6 +11005,9 @@ tests/webtbf/tw2053b.pp svneol=native#text/plain tests/webtbf/tw20580.pp svneol=native#text/pascal tests/webtbf/tw20661.pp svneol=native#text/plain tests/webtbf/tw2070.pp svneol=native#text/plain +tests/webtbf/tw20721a.pp svneol=native#text/pascal +tests/webtbf/tw20721b.pp svneol=native#text/pascal +tests/webtbf/tw20721c.pp svneol=native#text/pascal tests/webtbf/tw2128.pp svneol=native#text/plain tests/webtbf/tw2129.pp svneol=native#text/plain tests/webtbf/tw2154.pp svneol=native#text/plain diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 0026b0893e..5df6a09398 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1184,7 +1184,7 @@ implementation { the ID token has to be consumed before calling this function } procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags); var - isclassref : boolean; + isclassref:boolean; begin if sym=nil then begin @@ -1205,7 +1205,7 @@ implementation isclassref:=(p1.resultdef.typ=classrefdef); end else - isclassref:=false; + isclassref:=false; { we assume, that only procsyms and varsyms are in an object } { symbol table, for classes, properties are allowed } @@ -1449,11 +1449,16 @@ implementation p1:=nil; if is_member_read(srsym,srsymtable,p1,hdef) then begin - { if the field was originally found in an } - { objectsymtable, it means it's part of self - if only method from which it was called is - not class static } + { if the field was originally found in an } + { objectsymtable, it means it's part of self } + { if only method from which it was called is } + { not class static } if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + else if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct)) else @@ -1620,6 +1625,11 @@ implementation { check if it's a method/class method } if is_member_read(srsym,srsymtable,p1,hdef) then begin + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and + assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)); { not srsymtable.symtabletype since that can be } { withsymtable as well } if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then @@ -1648,7 +1658,12 @@ implementation if is_member_read(srsym,srsymtable,p1,hdef) then begin if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then - if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + else + if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then { no self node in static class methods } p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) else diff --git a/tests/webtbf/tw20721a.pp b/tests/webtbf/tw20721a.pp new file mode 100644 index 0000000000..c96dbd43b5 --- /dev/null +++ b/tests/webtbf/tw20721a.pp @@ -0,0 +1,69 @@ +{%norun} +{%fail} +program tw20721a; +{$mode delphi} +{$apptype console} + +type + TFrame = class + type + TNested = class + procedure ProcN; + end; + + var + fField: integer; + FNested: TNested; + + procedure ProcF; + constructor Create; + destructor Destroy; override; + property Field: integer read fField write fField; + end; + +var + Frame: TFrame; + + procedure TFrame.TNested.ProcN; + begin + ProcF; + end; + + procedure TFrame.ProcF; + begin + WriteLn(Self.ClassName); + WriteLn(NativeInt(Self)); + WriteLn(fField); + end; + + constructor TFrame.Create; + begin + inherited; + fField := 23; + FNested := TNested.Create; + end; + + destructor TFrame.Destroy; + begin + FNested.Free; + end; + +begin + Frame := TFrame.Create; + try + Frame.ProcF; { results: + TFrame +
+ 23 + } + Frame.FNested.ProcN; { results: + TFrame.TNested + +