Browse Source

* don't allow passing a field of a record that's not an lvalue as
var-parameter, nor allowing taking its address (mantis #20095)

git-svn-id: trunk@19199 -

Jonas Maebe 14 năm trước cách đây
mục cha
commit
dff5ac3b0a
3 tập tin đã thay đổi với 106 bổ sung5 xóa
  1. 1 0
      .gitattributes
  2. 2 5
      compiler/htypechk.pas
  3. 103 0
      tests/webtbf/tw20095.pp

+ 1 - 0
.gitattributes

@@ -10976,6 +10976,7 @@ tests/webtbf/tw1949.pp svneol=native#text/plain
 tests/webtbf/tw19591.pp svneol=native#text/plain
 tests/webtbf/tw1969.pp svneol=native#text/plain
 tests/webtbf/tw1995.pp svneol=native#text/plain
+tests/webtbf/tw20095.pp svneol=native#text/plain
 tests/webtbf/tw2018.pp svneol=native#text/plain
 tests/webtbf/tw2037.pp svneol=native#text/plain
 tests/webtbf/tw2046.pp svneol=native#text/plain

+ 2 - 5
compiler/htypechk.pas

@@ -1156,14 +1156,11 @@ implementation
                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
+                     2. if it returns a class and a subscription or with is found
                      3. if the address is needed of a field (subscriptn, vecn) }
                    if (gotpointer and gotderef) or
                       (gotstring and gotvec) or
-                      (
-                       (gotclass or gotrecord) and
-                       (gotsubscript)
-                      ) or
+                      (gotclass and gotsubscript) or
                       (
                         (gotvec and gotdynarray)
                       ) or

+ 103 - 0
tests/webtbf/tw20095.pp

@@ -0,0 +1,103 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  sysutils, Classes;
+
+type
+
+generic TBroken<_T> = class
+  private type
+    T_TArray = array of _T;
+  private var
+    FArray: T_TArray;
+  private
+    function FGetTopEntry(): _T;
+    procedure FSetTopEntry(Value: _T);
+  public
+    constructor Create(Len: integer);
+
+    property TopEntry: _T read FGetTopEntry write FSetTopEntry;
+end;
+
+TRecord = record
+  x, y, z: integer;
+end;
+
+TMaybeBroken = class
+  private
+    FArray: array of TRecord;
+
+    function FGetTopEntry(): TRecord;
+    procedure FSetTopEntry(Value: TRecord);
+  public
+    constructor Create(Len: integer);
+
+    property TopEntry: TRecord read FGetTopEntry write FSetTopEntry;
+end;
+
+
+TBrokenRecord = specialize TBroken<TRecord>; // pun intended
+
+var
+  a: TBrokenRecord;
+  b: TMaybeBroken;
+  i: integer;
+
+constructor TBroken.Create(Len: integer);
+  var
+    i: integer;
+  begin
+    SetLength(FArray, Len);
+    FillChar(FArray[0], SizeOf(_T) * Len, 0);
+end;
+
+function TBroken.FGetTopEntry(): _T;
+  begin
+    Result := FArray[High(FArray)];
+end;
+
+procedure TBroken.FSetTopEntry(Value: _T);
+  begin
+    FArray[High(FArray)] := Value;
+end;
+
+constructor TMaybeBroken.Create(Len: integer);
+  var
+    i: integer;
+  begin
+    SetLength(FArray, Len);
+    FillChar(FArray[0], SizeOf(TRecord) * Len, 0);
+end;
+
+function TMaybeBroken.FGetTopEntry(): TRecord;
+  begin
+    Result := FArray[High(FArray)];
+end;
+
+procedure TMaybeBroken.FSetTopEntry(Value: TRecord);
+  begin
+    FArray[High(FArray)] := Value;
+end;
+
+begin
+  a := TBrokenRecord.Create(10);
+  Inc(a.TopEntry.x);
+
+  for i := 0 to 9 do writeln(inttostr(a.FArray[i].x));
+
+  a.Free();
+
+  writeln('---');
+
+  b := TMaybeBroken.Create(10);
+  Inc(b.TopEntry.x);
+
+  for i := 0 to 9 do writeln(inttostr(b.FArray[i].x));
+
+  b.Free();
+
+end.