diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index d689acc12ce..0160e75ffb4 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -2507,6 +2507,29 @@ else if p.resultdef.typ=recorddef then end; + procedure materialize_helper_instance(var node:tnode;helperdef:tobjectdef); + var + n : tnode; + newstatement : tstatementnode; + temp : ttempcreatenode; + extdef : tdef; + begin + if not((node.nodetype in (nodetype_const+[addrn])) or + (nf_no_lvalue in node.flags)) then + exit; + extdef:=helperdef.extendeddef; + newstatement:=nil; + n:=internalstatements(newstatement); + temp:=ctempcreatenode.create(extdef,extdef.size,tt_persistent,false); + addstatement(newstatement,temp); + addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),node)); + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + node:=n; + do_typecheckpass(node) + end; + + { 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;spezcontext:tspecializationcontext); var @@ -2529,6 +2552,9 @@ else if p.resultdef.typ=recorddef then end else begin + if assigned(p1) and + is_objectpascal_helper(tdef(sym.owner.defowner)) then + materialize_helper_instance(p1,tobjectdef(sym.owner.defowner)); if assigned(p1) then begin if not assigned(p1.resultdef) then @@ -3225,10 +3251,6 @@ (tloadnode(p1).left.resultdef.typ=classrefdef) var srsym : tsym; srsymtable : tsymtable; - n : tnode; - newstatement : tstatementnode; - temp : ttempcreatenode; - extdef : tdef; begin result:=false; if (current_scanner.token=_ID) and (block_type in [bt_body,bt_general,bt_except,bt_const]) then @@ -3246,20 +3268,6 @@ (tloadnode(p1).left.resultdef.typ=classrefdef) if not (srsymtable.symtabletype=objectsymtable) or not is_objectpascal_helper(tdef(srsymtable.defowner)) then internalerror(2013011401); - { convert const node to temp node of the extended type } - if node.nodetype in (nodetype_const+[addrn]) then - begin - extdef:=tobjectdef(srsymtable.defowner).extendeddef; - newstatement:=nil; - n:=internalstatements(newstatement); - temp:=ctempcreatenode.create(extdef,extdef.size,tt_persistent,false); - addstatement(newstatement,temp); - addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),node)); - addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); - addstatement(newstatement,ctemprefnode.create(temp)); - node:=n; - do_typecheckpass(node) - end; check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); consume(_ID); do_member_read(nil,getaddr,srsym,node,again,[],nil); diff --git a/tests/webtbs/tw41589.pp b/tests/webtbs/tw41589.pp new file mode 100644 index 00000000000..2d771776fab --- /dev/null +++ b/tests/webtbs/tw41589.pp @@ -0,0 +1,67 @@ +program tw41589; + +{$mode delphi} + +type + TValue = record + A, B: LongInt; + end; + + TValueHelper = record helper for TValue + procedure SetA(Value: LongInt); + function Sum: LongInt; + end; + + THolder = class + private + FByField: TValue; + FByGetter: TValue; + function GetByGetter: TValue; + public + property ByField: TValue read FByField write FByField; + property ByGetter: TValue read GetByGetter write FByGetter; + end; + +procedure TValueHelper.SetA(Value: LongInt); +begin + Self.A := Value; +end; + +function TValueHelper.Sum: LongInt; +begin + Result := Self.A + Self.B; +end; + +function THolder.GetByGetter: TValue; +begin + Result := FByGetter; +end; + +var + Holder: THolder; + V: TValue; +begin + V.A := 100; + V.B := 200; + V.SetA(11); + if (V.A <> 11) or (V.Sum <> 211) then + Halt(1); + + Holder := THolder.Create; + try + V.A := 100; + V.B := 200; + Holder.ByField := V; + Holder.ByGetter := V; + + if (Holder.ByField.Sum <> 300) or (Holder.ByGetter.Sum <> 300) then + Halt(2); + + Holder.ByField.SetA(22); + Holder.ByGetter.SetA(33); + if (Holder.ByField.A <> 100) or (Holder.ByGetter.A <> 100) then + Halt(3); + finally + Holder.Free; + end; +end.