Browse Source

* mark nodes that have been created by transforming a read-accessor of
of a property with nf_no_lvalue flag, and check that such nodes are
never used in direct assignments (fixes mantis #21087 and a couple of
other cases of invalid assignments to properties)

git-svn-id: trunk@20140 -

Jonas Maebe 13 years ago
parent
commit
e5c097a6e2
5 changed files with 60 additions and 4 deletions
  1. 1 0
      .gitattributes
  2. 10 3
      compiler/htypechk.pas
  3. 3 0
      compiler/pexpr.pas
  4. 1 1
      compiler/ppu.pas
  5. 45 0
      tests/webtbf/tw21087.pp

+ 1 - 0
.gitattributes

@@ -11244,6 +11244,7 @@ tests/webtbf/tw2070.pp svneol=native#text/plain
 tests/webtbf/tw20721a.pp svneol=native#text/pascal
 tests/webtbf/tw20721a.pp svneol=native#text/pascal
 tests/webtbf/tw20721b.pp svneol=native#text/pascal
 tests/webtbf/tw20721b.pp svneol=native#text/pascal
 tests/webtbf/tw20721c.pp svneol=native#text/pascal
 tests/webtbf/tw20721c.pp svneol=native#text/pascal
+tests/webtbf/tw21087.pp svneol=native#text/plain
 tests/webtbf/tw2128.pp svneol=native#text/plain
 tests/webtbf/tw2128.pp svneol=native#text/plain
 tests/webtbf/tw2129.pp svneol=native#text/plain
 tests/webtbf/tw2129.pp svneol=native#text/plain
 tests/webtbf/tw2154.pp svneol=native#text/plain
 tests/webtbf/tw2154.pp svneol=native#text/plain

+ 10 - 3
compiler/htypechk.pas

@@ -1133,6 +1133,8 @@ implementation
                       (gotderef) or
                       (gotderef) or
                       { same when we got a class and subscript (= deref) }
                       { same when we got a class and subscript (= deref) }
                       (gotclass and gotsubscript) or
                       (gotclass and gotsubscript) or
+                      { indexing a dynamic array = dereference }
+                      (gotdynarray and gotvec) or
                       (
                       (
                        { allowing assignments to typecasted properties
                        { allowing assignments to typecasted properties
                            a) is Delphi-incompatible
                            a) is Delphi-incompatible
@@ -1146,7 +1148,8 @@ implementation
                        }
                        }
                        not(gottypeconv) and
                        not(gottypeconv) and
                        not(gotsubscript and gotrecord) and
                        not(gotsubscript and gotrecord) and
-                       not(gotstring and gotvec)
+                       not(gotstring and gotvec) and
+                       not(nf_no_lvalue in hp.flags)
                       ) then
                       ) then
                      result:=true
                      result:=true
                    else
                    else
@@ -1261,8 +1264,12 @@ implementation
                      exit;
                      exit;
                    end;
                    end;
                  gotvec:=true;
                  gotvec:=true;
-                 { accesses to dyn. arrays override read only access in delphi }
-                 if (m_delphi in current_settings.modeswitches) and is_dynamic_array(tunarynode(hp).left.resultdef) then
+                 { accesses to dyn. arrays override read only access in delphi
+                   -- now also in FPC, because the elements of a dynamic array
+                      returned by a function can also be changed, or you can
+                      assign the dynamic array to a variable and then change
+                      its elements anyway }
+                 if is_dynamic_array(tunarynode(hp).left.resultdef) then
                    gotdynarray:=true;
                    gotdynarray:=true;
                  hp:=tunarynode(hp).left;
                  hp:=tunarynode(hp).left;
                end;
                end;

+ 3 - 0
compiler/pexpr.pas

@@ -1154,6 +1154,8 @@ implementation
                          if not handle_staticfield_access(sym,false,p1) then
                          if not handle_staticfield_access(sym,false,p1) then
                            propaccesslist_to_node(p1,st,propaccesslist);
                            propaccesslist_to_node(p1,st,propaccesslist);
                          include(p1.flags,nf_isproperty);
                          include(p1.flags,nf_isproperty);
+                         { catch expressions like "(propx):=1;" }
+                         include(p1.flags,nf_no_lvalue);
                        end;
                        end;
                      procsym :
                      procsym :
                        begin
                        begin
@@ -1165,6 +1167,7 @@ implementation
                           p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
                           p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags);
                           paras:=nil;
                           paras:=nil;
                           include(p1.flags,nf_isproperty);
                           include(p1.flags,nf_isproperty);
+                          include(p1.flags,nf_no_lvalue);
                        end
                        end
                      else
                      else
                        begin
                        begin

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 {$endif Test_Double_checksum}
 
 
 const
 const
-  CurrentPPUVersion = 141;
+  CurrentPPUVersion = 142;
 
 
 { buffer sizes }
 { buffer sizes }
   maxentrysize = 1024;
   maxentrysize = 1024;

+ 45 - 0
tests/webtbf/tw21087.pp

@@ -0,0 +1,45 @@
+{ %fail }
+
+{$mode objfpc}{$H+}
+uses
+  Classes;
+
+type
+  TMyItem = class(TObject)
+  end;
+
+  TMyList = class(tfplist)
+    function GetItem(const I: Integer): TMyItem;
+    procedure SetItem(const I: Integer; const Item: TMyItem);
+  public
+    property Items[I: Integer]: TMyItem read GetItem write SetItem; default;
+  end;
+
+function TMyList.GetItem(const I: Integer): TMyItem;
+begin
+  Result := TMyItem(inherited Items[I]);
+end;
+
+procedure TMyList.SetItem(const I: Integer; const Item: TMyItem);
+begin
+  (inherited Items[I]) := Item;
+end;
+
+var
+  I1, I2: TMyItem;
+  L: TMyList;
+begin
+  try
+    I1 := TMyItem.Create;
+    I2 := TMyItem.Create;
+    L := TMyList.Create;
+
+    L.Add(I1);
+    L[0] := I2;
+    Assert(L[0] = I2);
+  finally
+    I1.Free;
+    I2.Free;
+    L.Free;
+  end;
+end.