compiler: don't allow to execute instance methods, use instance fields and properties from the nested class (bug #0020721)

git-svn-id: trunk@19681 -

.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

compiler/pexpr.pas

@@ -1450,10 +1450,15 @@ implementation
                     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
+                        { objectsymtable, it means it's part of self  }
-                          if only method from which it was called is
+                        { if only method from which it was called is  }
-                          not class static                          }
+                        { 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,6 +1658,11 @@ implementation
                     if is_member_read(srsym,srsymtable,p1,hdef) then
                       begin
                         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
                           { no self node in static class methods }
                             p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))

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
+      <address of Frame variable>
+      23
+    }
+    Frame.FNested.ProcN; { results:
+      TFrame.TNested
+      <address of field Frame.FNested>
+      <unpredictable: garbage or AV>
+    }
+  finally
+    Frame.Free
+  end;
+
+end.
+

tests/webtbf/tw20721b.pp

@@ -0,0 +1,69 @@
+{%norun}
+{%fail}
+program tw20721b;
+{$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
+    fField := 1;
+  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
+      <address of Frame variable>
+      23
+    }
+    Frame.FNested.ProcN; { results:
+      TFrame.TNested
+      <address of field Frame.FNested>
+      <unpredictable: garbage or AV>
+    }
+  finally
+    Frame.Free
+  end;
+
+end.
+

tests/webtbf/tw20721c.pp

@@ -0,0 +1,69 @@
+{%norun}
+{%fail}
+program tw20721c;
+{$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
+    Field := 1;
+  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
+      <address of Frame variable>
+      23
+    }
+    Frame.FNested.ProcN; { results:
+      TFrame.TNested
+      <address of field Frame.FNested>
+      <unpredictable: garbage or AV>
+    }
+  finally
+    Frame.Free
+  end;
+
+end.
+