* allow modifying lvalues obtained by dereferencing read-only properties,

both via regular pointers and via classes (mantis 9498)

git-svn-id: trunk@8755 -

.gitattributes

@@ -7495,6 +7495,7 @@ tests/webtbf/tw9522d.pp svneol=native#text/plain
 tests/webtbf/tw9522e.pp svneol=native#text/plain
 tests/webtbf/tw9579a.pp svneol=native#text/plain
 tests/webtbf/tw9579b.pp svneol=native#text/plain
+tests/webtbf/tw9894b.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
@@ -8474,6 +8475,8 @@ tests/webtbs/tw9695.pp svneol=native#text/plain
 tests/webtbs/tw9704.pp svneol=native#text/plain
 tests/webtbs/tw9766.pp svneol=native#text/plain
 tests/webtbs/tw9827.pp svneol=native#text/plain
+tests/webtbs/tw9894.pp svneol=native#text/plain
+tests/webtbs/tw9894a.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -987,10 +987,14 @@ implementation
                      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
+                      { if we got a deref, we won't modify the property itself }
+                      (gotderef) or
+                      { same when we got a class and subscript (= deref) }
+                      (gotclass and gotsubscript) or
+                      (
+                       not(gotsubscript and gotrecord) and
+                       not(gotstring and gotvec)
+                      ) then
                      result:=true
                    else
                      if report_errors then

tests/webtbf/tw9894b.pp

@@ -0,0 +1,37 @@
+{ %fail }
+
+{$mode delphi}
+
+unit tw9894b;
+
+interface
+
+Type
+  TMyInteger = Class
+    Value : Integer;
+  end;
+
+  TMyRec2 = record
+    MyInteger : TMyInteger;
+  end;
+
+  TMyRec = record
+    MyRec2 : TMyRec2;
+  end;
+
+  TMyClass = Class
+    FMyRec : TMyRec;
+  Private
+    Procedure DoSomething;
+    Property MyRec : TMyRec Read FMyRec;
+  end;
+
+Implementation
+
+Procedure TMyClass.DoSomething;
+
+begin
+  MyRec.MyRec2.MyInteger:=TMyInteger(nil);
+end;
+
+end.

tests/webtbs/tw9894.pp

@@ -0,0 +1,32 @@
+{$mode delphi}
+
+unit tw9894;
+
+interface
+
+Type
+  PMyInteger = ^TMyInteger;
+  TMyInteger = record
+    Value : Integer;
+  end;
+
+  TMyRec = record
+    MyInteger : PMyInteger;
+  end;
+
+  TMyClass = Class
+    FMyRec : TMyRec;
+  Private
+    Procedure DoSomething;
+    Property MyRec : TMyRec Read FMyRec;
+  end;
+
+Implementation
+
+Procedure TMyClass.DoSomething;
+
+begin
+  MyRec.MyInteger^.Value:=3;
+end;
+
+end.

tests/webtbs/tw9894a.pp

@@ -0,0 +1,31 @@
+{$mode delphi}
+
+unit tw9894a;
+
+interface
+
+Type
+  TMyInteger = Class
+    Value : Integer;
+  end;
+
+  TMyRec = record
+    MyInteger : TMyInteger;
+  end;
+
+  TMyClass = Class
+    FMyRec : TMyRec;
+  Private
+    Procedure DoSomething;
+    Property MyRec : TMyRec Read FMyRec;
+  end;
+
+Implementation
+
+Procedure TMyClass.DoSomething;
+
+begin
+  MyRec.MyInteger.Value:=3;
+end;
+
+end.