Explorar o código

* don't allow assignments to properties that need a call
and generate a temp structure

git-svn-id: trunk@485 -

peter %!s(int64=20) %!d(string=hai) anos
pai
achega
1abbfcc698
Modificáronse 3 ficheiros con 106 adicións e 36 borrados
  1. 1 0
      .gitattributes
  2. 55 36
      compiler/htypechk.pas
  3. 50 0
      tests/webtbf/tw4111.pp

+ 1 - 0
.gitattributes

@@ -5460,6 +5460,7 @@ tests/webtbf/tw3738.pp svneol=native#text/plain
 tests/webtbf/tw3740.pp svneol=native#text/plain
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3841.pp svneol=native#text/plain
+tests/webtbf/tw4111.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain

+ 55 - 36
compiler/htypechk.pas

@@ -841,6 +841,7 @@ implementation
         gotstring,
         gotwith,
         gotsubscript,
+        gotrecord,
         gotpointer,
         gotvec,
         gotclass,
@@ -858,6 +859,7 @@ implementation
         gotsubscript:=false;
         gotvec:=false;
         gotderef:=false;
+        gotrecord:=false;
         gotclass:=false;
         gotpointer:=false;
         gotwith:=false;
@@ -875,43 +877,60 @@ implementation
            { property allowed? calln has a property check itself }
            if (nf_isproperty in hp.flags) then
             begin
-              if (hp.nodetype<>calln) or
-                 (valid_property in opts) then
-               result:=true
+              if (hp.nodetype=calln) then
+                begin
+                  { check return type }
+                  case hp.resulttype.def.deftype of
+                    pointerdef :
+                      gotpointer:=true;
+                    objectdef :
+                      gotclass:=is_class_or_interface(hp.resulttype.def);
+                    recorddef :
+                      gotrecord:=true;
+                    classrefdef :
+                      gotclass:=true;
+                    stringdef :
+                      gotstring:=true;
+                  end;
+                  if (valid_property in opts) then
+                    begin
+                      { don't allow writing to calls that will create
+                        temps like calls that return a structure and we
+                        are assigning to a member }
+                      if (valid_const in opts) or
+                         not(
+                             (gotsubscript and gotrecord) or
+                             (gotstring and gotvec)
+                            ) then
+                        result:=true
+                      else
+                        CGMessagePos(hp.fileinfo,errmsg);
+                    end
+                  else
+                    begin
+                      { 1. if it returns a pointer and we've found a deref,
+                        2. if it returns a class or record and a subscription or with is found
+                        3. if the address is needed of a field (subscriptn) }
+                      if (gotpointer and gotderef) or
+                         (gotstring and gotvec) or
+                         (
+                          (gotclass or gotrecord) and
+                          (gotsubscript or gotwith)
+                         ) or
+                         (
+                           (gotvec and gotdynarray)
+                         ) or
+                         (
+                          (Valid_Addr in opts) and
+                          (hp.nodetype=subscriptn)
+                         ) then
+                        result:=true
+                      else
+                        CGMessagePos(hp.fileinfo,errmsg);
+                    end;
+                end
               else
-               begin
-                 { check return type }
-                 case hp.resulttype.def.deftype of
-                   pointerdef :
-                     gotpointer:=true;
-                   objectdef :
-                     gotclass:=is_class_or_interface(hp.resulttype.def);
-                   recorddef, { handle record like class it needs a subscription }
-                   classrefdef :
-                     gotclass:=true;
-                   stringdef :
-                     gotstring:=true;
-                 end;
-                 { 1. if it returns a pointer and we've found a deref,
-                   2. if it returns a class or record and a subscription or with is found
-                   3. if the address is needed of a field (subscriptn) }
-                 if (gotpointer and gotderef) or
-                    (gotstring and gotvec) or
-                    (
-                     gotclass and
-                     (gotsubscript or gotwith)
-                    ) or
-                    (
-                      (gotvec and gotdynarray)
-                    ) or
-                    (
-                     (Valid_Addr in opts) and
-                     (hp.nodetype=subscriptn)
-                    ) then
-                   result:=true
-                 else
-                   CGMessagePos(hp.fileinfo,errmsg);
-               end;
+                result:=true;
               exit;
             end;
            if (Valid_Const in opts) and is_constnode(hp) then

+ 50 - 0
tests/webtbf/tw4111.pp

@@ -0,0 +1,50 @@
+{ %fail }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+type
+  TPoint = record
+    X,Y : integer;
+  end;
+
+  { TSomeUselessObject }
+
+  TSomeUselessObject = class(TObject)
+    fSomeProperty: TPoint;
+  private
+    function GetSomeProperty: TPoint;
+    procedure SetSomeProperty(AValue: TPoint);
+  public
+    constructor Create;
+    property SomeProperty: TPoint read GetSomeProperty write SetSomeProperty;
+  end;
+
+{ TSomeUselessObject }
+
+procedure TSomeUselessObject.SetSomeProperty(AValue: TPoint);
+begin
+  fSomeProperty := AValue;
+end;
+
+function TSomeUselessObject.GetSomeProperty: TPoint;
+begin
+  Result := fSomeProperty;
+end;
+
+constructor TSomeUselessObject.Create;
+begin
+  fSomeProperty.X := 50;
+  fSomeProperty.Y := 100;
+end;
+
+var SomeUselessObject: TSomeUselessObject;
+
+begin
+  SomeUselessObject := TSomeUselessObject.Create;
+  WriteLn('By Default X = ', SomeUselessObject.SomeProperty.X, ' and Y = ',
+SomeUselessObject.fSomeProperty.Y);
+  SomeUselessObject.SomeProperty.X := 200;
+  SomeUselessObject.SomeProperty.Y := 500;
+  WriteLn('Now X = ', SomeUselessObject.SomeProperty.X, ' and Y = ',
+SomeUselessObject.fSomeProperty.Y);
+end.