diff --git a/.gitattributes b/.gitattributes index 6c9fec30e3..39c28899e9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -17318,6 +17318,7 @@ tests/webtbs/tw2627.pp svneol=native#text/plain tests/webtbs/tw26271.pp svneol=native#text/pascal tests/webtbs/tw26288.pp svneol=native#text/pascal tests/webtbs/tw2631.pp svneol=native#text/plain +tests/webtbs/tw26326.pp svneol=native#text/pascal tests/webtbs/tw26402.pp svneol=native#text/plain tests/webtbs/tw26403.pp svneol=native#text/pascal tests/webtbs/tw26408.pp svneol=native#text/pascal diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 4c0587085f..bbeb9d6548 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1297,6 +1297,9 @@ implementation break; loadn : begin + { the class pointer is read } + if assigned(tunarynode(p).left) then + set_varstate(tunarynode(p).left,vs_read,[vsf_must_be_valid]); if (tloadnode(p).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) then begin hsym:=tabstractvarsym(tloadnode(p).symtableentry); @@ -1377,6 +1380,8 @@ implementation end; break; end; + addrn: + break; callparan : internalerror(200310081); else diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 75c7a79c62..7ce63bc76f 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -535,6 +535,22 @@ implementation function taddrnode.pass_typecheck:tnode; + + procedure check_mark_read_written; + begin + if mark_read_written then + begin + { This is actually only "read", but treat it nevertheless as + modified due to the possible use of pointers + To avoid false positives regarding "uninitialised" + warnings when using arrays, perform it in two steps } + set_varstate(left,vs_written,[]); + { vsf_must_be_valid so it doesn't get changed into + vsf_referred_not_inited } + set_varstate(left,vs_read,[vsf_must_be_valid]); + end; + end; + var hp : tnode; hsym : tfieldvarsym; @@ -629,9 +645,11 @@ implementation end else begin + check_mark_read_written; { Return the typeconvn only } result:=left; left:=nil; + exit; end; end else @@ -650,17 +668,8 @@ implementation CGMessage(type_e_variable_id_expected); end; - if mark_read_written then - begin - { This is actually only "read", but treat it nevertheless as } - { modified due to the possible use of pointers } - { To avoid false positives regarding "uninitialised" } - { warnings when using arrays, perform it in two steps } - set_varstate(left,vs_written,[]); - { vsf_must_be_valid so it doesn't get changed into } - { vsf_referred_not_inited } - set_varstate(left,vs_read,[vsf_must_be_valid]); - end; + check_mark_read_written; + if not(assigned(result)) then result:=simplify(false); end; diff --git a/tests/webtbs/tw26326.pp b/tests/webtbs/tw26326.pp new file mode 100644 index 0000000000..be38143482 --- /dev/null +++ b/tests/webtbs/tw26326.pp @@ -0,0 +1,31 @@ +{ %opt=-vn -Sen } +{ %norun } +{$mode objfpc} +type + TForm = class + procedure OnClick; + end; + + TNotifyEvent = procedure of object; + +procedure TForm.OnClick; + begin + end; + + +procedure Test (aObject: TObject); +var + aForm: TForm; + aEvent: TNotifyEvent; +begin + if (aObject is TForm) then + begin + aForm := aObject as TForm; + aEvent := @aForm.OnClick; + aEvent(); + end; +end; + +begin + Test(nil); +end.