* correctly handle reading of class/object pointers in combination with @, resolves #26326

git-svn-id: trunk@43804 -

.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

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

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;

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.