Forráskód Böngészése

* don't internalerror when a property is hidden by a method in a child class
(mantis #17675)

git-svn-id: trunk@16191 -

Jonas Maebe 15 éve
szülő
commit
5e84c557fa
4 módosított fájl, 96 hozzáadás és 3 törlés
  1. 2 0
      .gitattributes
  2. 3 3
      compiler/htypechk.pas
  3. 45 0
      tests/webtbs/tw17675.pp
  4. 46 0
      tests/webtbs/tw17675a.pp

+ 2 - 0
.gitattributes

@@ -10708,6 +10708,8 @@ tests/webtbs/tw17550.pp svneol=native#text/plain
 tests/webtbs/tw1758.pp svneol=native#text/plain
 tests/webtbs/tw17604.pp svneol=native#text/plain
 tests/webtbs/tw1765.pp svneol=native#text/plain
+tests/webtbs/tw17675.pp svneol=native#text/plain
+tests/webtbs/tw17675a.pp svneol=native#text/plain
 tests/webtbs/tw1779.pp svneol=native#text/plain
 tests/webtbs/tw1780.pp svneol=native#text/plain
 tests/webtbs/tw1792.pp svneol=native#text/plain

+ 3 - 3
compiler/htypechk.pas

@@ -1729,10 +1729,10 @@ implementation
         while assigned(objdef) do
          begin
            srsym:=tprocsym(objdef.symtable.FindWithHash(hashedid));
-           if assigned(srsym) then
+           if assigned(srsym) and
+              { Delphi allows hiding a property by a procedure with the same name }
+              (srsym.typ=procsym) then
              begin
-               if (srsym.typ<>procsym) then
-                 internalerror(200111022);
                { add all definitions }
                hasoverload:=false;
                for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do

+ 45 - 0
tests/webtbs/tw17675.pp

@@ -0,0 +1,45 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes;
+
+type
+
+  TBase = class
+  private
+    function GetCount: Integer;
+  public
+    property Count: Integer read GetCount;
+  end;
+
+  TSub = class(TBase)
+  public
+    function Count: Integer; overload;
+  end;
+
+function TSub.Count: Integer;
+begin
+  Result := 2;
+end;
+
+{ TBase }
+
+function TBase.GetCount: Integer;
+begin
+  Result := 1;
+end;
+
+var
+  MySub: TSub;
+  i : Integer;
+begin
+  MySub := TSub.Create;
+// uncomment the next line for Fatal Internal error 200111022:
+ if MySub.Count <> 2 then
+   halt(1);
+end.

+ 46 - 0
tests/webtbs/tw17675a.pp

@@ -0,0 +1,46 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes;
+
+type
+
+  TBase = class
+  public
+    function Count: Integer; overload;
+  end;
+
+  TSub = class(TBase)
+  private
+    function GetCount: Integer;
+  public
+    property Count: Integer read GetCount;
+  end;
+
+function TSub.Count: Integer;
+begin
+  Result := 0;
+end;
+
+{ TBase }
+
+function TBase.GetCount: Integer;
+begin
+  Result := 0;
+end;
+
+var
+  MySub: TSub;
+  i : Integer;
+begin
+  MySub := TSub.Create;
+// uncomment the next line for Fatal Internal error 200111022:
+ for i := 0 to MySub.Count do begin end;
+end.