Browse Source

- revert fix for #10927: the old behaviour was Delphi compatible,
and the fix caused other problems (#10979)

git-svn-id: trunk@10464 -

Jonas Maebe 17 năm trước cách đây
mục cha
commit
8adc596c16
4 tập tin đã thay đổi với 48 bổ sung26 xóa
  1. 1 0
      .gitattributes
  2. 2 26
      compiler/pexpr.pas
  3. 2 0
      tests/webtbs/tw10927.pp
  4. 43 0
      tests/webtbs/tw10979.pp

+ 1 - 0
.gitattributes

@@ -8013,6 +8013,7 @@ tests/webtbs/tw10931.pp svneol=native#text/plain
 tests/webtbs/tw1096.pp svneol=native#text/plain
 tests/webtbs/tw10966.pp svneol=native#text/plain
 tests/webtbs/tw1097.pp svneol=native#text/plain
+tests/webtbs/tw10979.pp svneol=native#text/plain
 tests/webtbs/tw1103.pp svneol=native#text/plain
 tests/webtbs/tw1104.pp svneol=native#text/plain
 tests/webtbs/tw1111.pp svneol=native#text/plain

+ 2 - 26
compiler/pexpr.pas

@@ -1062,21 +1062,6 @@ implementation
                      fieldvarsym :
                        begin
                          { generate access code }
-
-                         { for fieldvars, having a typenode is wrong:   }
-                         { fields cannot be overridden/hidden in child  }
-                         { classes. However, we always have to pass the }
-                         { typenode to handle_propertysym because the   }
-                         { parent doesn't know yet to what the property }
-                         { will resolve (and in case of procsyms, we do }
-                         { need the type node in case of                }
-                         { "inherited property_with_getter/setter"      }
-                         if (assigned(p1)) and
-                            (p1.nodetype = typen) then
-                           begin
-                             p1.free;
-                             p1:=nil;
-                           end;
                          propaccesslist_to_node(p1,st,propaccesslist);
                          include(p1.flags,nf_isproperty);
                          consume(_ASSIGNMENT);
@@ -1105,15 +1090,6 @@ implementation
                      fieldvarsym :
                        begin
                           { generate access code }
-
-                          { for fieldvars, having a typenode is wrong:   }
-                          { see comments above for write access          }
-                          if (assigned(p1)) and
-                             (p1.nodetype = typen) then
-                            begin
-                              p1.free;
-                              p1:=nil;
-                            end;
                           propaccesslist_to_node(p1,st,propaccesslist);
                           include(p1.flags,nf_isproperty);
                        end;
@@ -2258,14 +2234,14 @@ implementation
                        not from self }
                      if srsym.typ in [procsym,propertysym] then
                       begin
-                        hdef:=hclassdef;
                         if (srsym.typ = procsym) then
                           begin
+                            hdef:=hclassdef;
                             if (po_classmethod in current_procinfo.procdef.procoptions) or
                                (po_staticmethod in current_procinfo.procdef.procoptions) then
                               hdef:=tclassrefdef.create(hdef);
+                            p1:=ctypenode.create(hdef);
                           end;
-                        p1:=ctypenode.create(hdef);
                       end
                      else
                       begin

+ 2 - 0
tests/webtbs/tw10927.pp

@@ -1,3 +1,5 @@
+{ %result=1 }
+
 program project1;
 
 {$mode objfpc}{$H+}

+ 43 - 0
tests/webtbs/tw10979.pp

@@ -0,0 +1,43 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+
+uses Classes;
+
+{$ifndef fpc}
+type
+  ptruint = cardinal;
+{$endif}
+
+type
+  TMyStringList = class(TStringList)
+  private
+    function GetObjects(Index: Integer): TStringList;
+    procedure SetObjects(Index: Integer; const Value: TStringList);  
+  public
+    property Objects[Index: Integer]: TStringList read GetObjects write SetObjects;
+  end;
+
+function TMyStringList.GetObjects(Index: Integer): TStringList;
+begin
+  Result := TStringList(inherited Objects[Index]);
+end;
+
+procedure TMyStringList.SetObjects(Index: Integer; const Value: TStringList);
+begin
+  writeln('setobjects called');
+  inherited Objects[Index] := Value;
+end;
+
+              
+var
+  SL: TMyStringList;
+begin
+  SL := TMyStringList.Create;
+  SL.AddObject('Hello',SL);
+  WriteLn(SL[0],':',PtrUint(SL.Objects[0]),':',PtrUint(SL));
+  if (sl[0]<>'Hello') or
+     (PtrUint(SL.Objects[0])<>PtrUint(SL)) then
+    halt(1);
+end.
+