mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:09:31 +02:00
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:
parent
c3c345d569
commit
04adcf2a12
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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
27
tests/webtbs/tw30179.pp
Normal 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
48
tests/webtbs/tw30203.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user