From 04adcf2a1294f68e5afb896475a61a0a387f18e0 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Wed, 1 Jun 2016 20:06:40 +0000 Subject: [PATCH] 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 - --- .gitattributes | 2 ++ compiler/pexpr.pas | 31 +++++++++++++++++--------- tests/webtbs/tw30179.pp | 27 +++++++++++++++++++++++ tests/webtbs/tw30203.pp | 48 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 98 insertions(+), 10 deletions(-) create mode 100644 tests/webtbs/tw30179.pp create mode 100644 tests/webtbs/tw30203.pp diff --git a/.gitattributes b/.gitattributes index 80599dce79..5751e61983 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 957f5a0864..47c96cebd0 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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, diff --git a/tests/webtbs/tw30179.pp b/tests/webtbs/tw30179.pp new file mode 100644 index 0000000000..f61d79aed3 --- /dev/null +++ b/tests/webtbs/tw30179.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +program tw30179; + +{$MODE DELPHI} + +type + TTest1 = record + class function Add(const A, B: T): T; static; inline; + end; + +class function TTest1.Add(const A, B: T): T; +begin + Result := A + B; +end; + +procedure Main(); +var + I: Integer; +begin + I := TTest1.Add(1, 2); // project1.lpr(14,26) Error: Identifier not found "Add$1" +end; + +begin + Main(); +end. + diff --git a/tests/webtbs/tw30203.pp b/tests/webtbs/tw30203.pp new file mode 100644 index 0000000000..72af6b8e33 --- /dev/null +++ b/tests/webtbs/tw30203.pp @@ -0,0 +1,48 @@ +{ %NORUN } + +program tw30203; + +{$MODE DELPHI} +{$POINTERMATH ON} + +procedure QuickSort(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(A, Index, I - 1); + QuickSort(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(arri, Low(arri), High(arri)); + QuickSort(arrs, Low(arrs), High(arrs)); +end.