Browse Source

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 -
svenbarth 9 years ago
parent
commit
04adcf2a12
4 changed files with 98 additions and 10 deletions
  1. 2 0
      .gitattributes
  2. 21 10
      compiler/pexpr.pas
  3. 27 0
      tests/webtbs/tw30179.pp
  4. 48 0
      tests/webtbs/tw30203.pp

+ 2 - 0
.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

+ 21 - 10
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,

+ 27 - 0
tests/webtbs/tw30179.pp

@@ -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 - 0
tests/webtbs/tw30203.pp

@@ -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.