--- Merging r19681 into '.':

A    tests/webtbf/tw20721a.pp
A    tests/webtbf/tw20721b.pp
A    tests/webtbf/tw20721c.pp
U    compiler/pexpr.pas

# revisions: 19681
------------------------------------------------------------------------
r19681 | paul | 2011-11-25 09:33:24 +0100 (Fri, 25 Nov 2011) | 1 line
Changed paths:
   M /trunk/compiler/pexpr.pas
   A /trunk/tests/webtbf/tw20721a.pp
   A /trunk/tests/webtbf/tw20721b.pp
   A /trunk/tests/webtbf/tw20721c.pp

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


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_2_6@19716 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 229 insertions, 7 deletions

diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 22c4273d21..df6323912d 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1180,7 +1180,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
@@ -1201,7 +1201,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          }
@@ -1445,11 +1445,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
@@ -1613,6 +1618,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
@@ -1641,7 +1651,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
+      <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.
+
diff --git a/tests/webtbf/tw20721b.pp b/tests/webtbf/tw20721b.pp
new file mode 100644
index 0000000000..73e3bed515
--- /dev/null
+++ b/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.
+
diff --git a/tests/webtbf/tw20721c.pp b/tests/webtbf/tw20721c.pp
new file mode 100644
index 0000000000..ce24fc25a6
--- /dev/null
+++ b/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.
+