Fix for Mantis #30179 and #30203.

pexpr.pas:
  * handle_factor_typenode: rework code for records and objects so that Delphi style specializations are handled as well
  * sub_expr.generate_inline_specialization: also do a typecheck pass on pload to be sure that we have a resultdef

+ added tests

git-svn-id: trunk@33876 -
This commit is contained in:
svenbarth 2016-06-01 20:06:40 +00:00
parent c3c345d569
commit 04adcf2a12
4 changed files with 98 additions and 10 deletions

2
.gitattributes vendored
View File

@ -15109,7 +15109,9 @@ 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/tw30179.pp svneol=native#text/pascal
tests/webtbs/tw30202.pp svneol=native#text/pascal
tests/webtbs/tw30203.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

@ -1462,8 +1462,10 @@ implementation
var
srsym : tsym;
srsymtable : tsymtable;
erroroutresult,
isspecialize : boolean;
spezcontext : tspecializationcontext;
savedfilepos : tfileposinfo;
begin
spezcontext:=nil;
if sym=nil then
@ -1549,32 +1551,40 @@ implementation
end
else
isspecialize:=false;
erroroutresult:=true;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
if isspecialize then
if isspecialize and assigned(srsym) then
begin
consume(_ID);
if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
begin
result.free;
result:=cerrornode.create;
end;
if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
erroroutresult:=false;
end
else
begin
if assigned(srsym) then
begin
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
savedfilepos:=current_filepos;
consume(_ID);
if not (sp_generic_dummy in srsym.symoptions) or
not (token in [_LT,_LSHARPBRACKET]) then
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,savedfilepos)
else
result:=cspecializenode.create(result,getaddr,srsym);
erroroutresult:=false;
end
else
Message1(sym_e_id_no_member,orgpattern);
end;
if (result.nodetype<>errorn) and assigned(srsym) then
do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext)
if erroroutresult then
begin
result.free;
result:=cerrornode.create;
end
else
spezcontext.free;
if result.nodetype<>specializen then
do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext);
end;
end
else
@ -3964,6 +3974,7 @@ implementation
if assigned(pload) then
begin
result:=pload;
typecheckpass(result);
structdef:=nil;
case result.resultdef.typ of
objectdef,

27
tests/webtbs/tw30179.pp Normal file
View File

@ -0,0 +1,27 @@
{ %NORUN }
program tw30179;
{$MODE DELPHI}
type
TTest1 = record
class function Add<T>(const A, B: T): T; static; inline;
end;
class function TTest1.Add<T>(const A, B: T): T;
begin
Result := A + B;
end;
procedure Main();
var
I: Integer;
begin
I := TTest1.Add<Integer>(1, 2); // project1.lpr(14,26) Error: Identifier not found "Add$1"
end;
begin
Main();
end.

48
tests/webtbs/tw30203.pp Normal file
View File

@ -0,0 +1,48 @@
{ %NORUN }
program tw30203;
{$MODE DELPHI}
{$POINTERMATH ON}
procedure 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);
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';
QuickSort<LongInt>(arri, Low(arri), High(arri));
QuickSort<String>(arrs, Low(arrs), High(arrs));
end.