Browse Source

* treat methods called via records the same as records called via objects
without virtual methods: they may initialise the instance (mantis #23667)

git-svn-id: trunk@23976 -

Jonas Maebe 12 years ago
parent
commit
1601f6bea8
3 changed files with 33 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 6 2
      compiler/ncal.pas
  3. 26 0
      tests/webtbs/tw23667.pp

+ 1 - 0
.gitattributes

@@ -13275,6 +13275,7 @@ tests/webtbs/tw23503.pp svneol=native#text/pascal
 tests/webtbs/tw2351.pp svneol=native#text/plain
 tests/webtbs/tw23568.pp -text svneol=native#text/plain
 tests/webtbs/tw2363.pp svneol=native#text/plain
+tests/webtbs/tw23667.pp svneol=native#text/plain
 tests/webtbs/tw23725.pp svneol=native#text/pascal
 tests/webtbs/tw23744.pp svneol=native#text/plain
 tests/webtbs/tw2377.pp svneol=native#text/plain

+ 6 - 2
compiler/ncal.pas

@@ -3150,6 +3150,8 @@ implementation
                 hpt:=methodpointer;
                 while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
                   hpt:=tunarynode(hpt).left;
+                { skip (absolute and other simple) type conversions }
+                hpt:=hpt.actualtargetnode;
 
                 if ((hpt.nodetype=loadvmtaddrn) or
                    ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
@@ -3169,8 +3171,10 @@ implementation
                  Also allow it for simple loads }
                if (procdefinition.proctypeoption=potype_constructor) or
                   ((hpt.nodetype=loadn) and
-                   (methodpointer.resultdef.typ=objectdef) and
-                   not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)
+                   (((methodpointer.resultdef.typ=objectdef) and
+                     not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
+                    (methodpointer.resultdef.typ=recorddef)
+                   )
                   ) then
                  { a constructor will and a method may write something to }
                  { the fields                                             }

+ 26 - 0
tests/webtbs/tw23667.pp

@@ -0,0 +1,26 @@
+{ %opt=-vw -Sew }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  tpoint = record
+    x,y: longint;
+    function add(const aPoint:Tpoint):TPoint;
+    procedure setlocation(xx,yy: longint);
+  end;
+
+procedure tpoint.setlocation(xx,yy: longint);
+begin
+  x:=xx;
+  y:=yy;
+end;
+
+function TPoint.Add(const aPoint:Tpoint):TPoint;
+ begin
+   Result.SetLocation(self.x+aPoint.X, self.Y+aPoint.Y);
+ end;
+
+begin
+end.