Fix for Mantis #30202.

pexpr.pas, sub_expr.generate_inline_specialization:
  * do_member_read() needs to happen independently of whether we're calling a method of the same object (was incorrectly copypasted code... :/ )

+ added test

git-svn-id: trunk@33875 -
This commit is contained in:
svenbarth 2016-06-01 20:03:59 +00:00
parent a7516dfb50
commit c3c345d569
3 changed files with 64 additions and 12 deletions

1
.gitattributes vendored
View File

@ -15109,6 +15109,7 @@ tests/webtbs/tw30119a.pp svneol=native#text/pascal
tests/webtbs/tw30119b.pp svneol=native#text/pascal
tests/webtbs/tw3012.pp svneol=native#text/plain
tests/webtbs/tw30166.pp svneol=native#text/plain
tests/webtbs/tw30202.pp svneol=native#text/pascal
tests/webtbs/tw3023.pp svneol=native#text/plain
tests/webtbs/tw3028.pp svneol=native#text/plain
tests/webtbs/tw3038.pp svneol=native#text/plain

View File

@ -3992,19 +3992,17 @@ implementation
{ class we need to call it as a class member }
if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
assigned(current_structdef) and (current_structdef<>parseddef) and is_owned_by(current_structdef,parseddef) then
result:=cloadvmtaddrnode.create(ctypenode.create(parseddef));
{ not srsymtable.symtabletype since that can be }
{ withsymtable as well }
if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
begin
result:=cloadvmtaddrnode.create(ctypenode.create(parseddef));
{ not srsymtable.symtabletype since that can be }
{ withsymtable as well }
if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
begin
do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext);
spezcontext:=nil;
end
else
{ no procsyms in records (yet) }
internalerror(2015092704);
end;
do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext);
spezcontext:=nil;
end
else
{ no procsyms in records (yet) }
internalerror(2015092704);
end
else
begin

53
tests/webtbs/tw30202.pp Normal file
View File

@ -0,0 +1,53 @@
{ %NORUN }
program tw30202;
{$MODE DELPHI}
{$POINTERMATH ON}
type
TArray = record
class procedure QuickSort<T>(var A: Array of T; const Index, Count: Integer); static; inline;
end;
class procedure TArray.QuickSort<T>(var A: Array of T; const Index, Count: Integer);
var
I, J: Integer;
Temp, Pivot: T;
begin
if Index < Count then
begin
Pivot := A[Random(Count - Index) + Index + 1];
I := Index - 1;
J := Count + 1;
repeat
repeat Inc(I) until A[I] >= Pivot;
repeat Dec(J) until A[J] <= Pivot;
Temp := A[I];
A[I] := A[J];
A[J] := Temp;
until I >= J;
A[J] := A[I];
A[I] := Temp;
QuickSort<T>(A, Index, I - 1); // project1.lpr(30,17) Error: Compilation raised exception internally
QuickSort<T>(A, I, Count);
end;
end;
var
arri: array of LongInt;
arrs: array of String;
begin
SetLength(arri, 4);
arri[0] := 4;
arri[1] := 2;
arri[2] := 6;
arri[3] := 1;
SetLength(arrs, 4);
arrs[0] := 'World';
arrs[1] := 'Alpha';
arrs[2] := 'Hello';
arrs[3] := 'Foo';
TArray.QuickSort<LongInt>(arri, Low(arri), High(arri));
TArray.QuickSort<String>(arrs, Low(arrs), High(arrs));
end.