Bläddra i källkod

* accept with statements with generic variables having a generic parameter type, resolves #21329

git-svn-id: trunk@23243 -
florian 12 år sedan
förälder
incheckning
728c074bd6
8 ändrade filer med 127 tillägg och 16 borttagningar
  1. 2 0
      .gitattributes
  2. 11 0
      compiler/htypechk.pas
  3. 39 3
      compiler/pexpr.pas
  4. 18 10
      compiler/pstatmnt.pas
  5. 2 2
      compiler/symconst.pas
  6. 2 1
      compiler/symtable.pas
  7. 24 0
      tests/test/tgeneric92.pp
  8. 29 0
      tests/webtbs/tw21329.pp

+ 2 - 0
.gitattributes

@@ -10965,6 +10965,7 @@ tests/test/tgeneric89.pp svneol=native#text/pascal
 tests/test/tgeneric9.pp svneol=native#text/plain
 tests/test/tgeneric90.pp svneol=native#text/pascal
 tests/test/tgeneric91.pp svneol=native#text/pascal
+tests/test/tgeneric92.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -12973,6 +12974,7 @@ tests/webtbs/tw2128.pp svneol=native#text/plain
 tests/webtbs/tw2129.pp svneol=native#text/plain
 tests/webtbs/tw2129b.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
+tests/webtbs/tw21329.pp svneol=native#text/pascal
 tests/webtbs/tw21350a.pp svneol=native#text/pascal
 tests/webtbs/tw21350b.pp svneol=native#text/pascal
 tests/webtbs/tw21443.pp svneol=native#text/plain

+ 11 - 0
compiler/htypechk.pas

@@ -1776,6 +1776,17 @@ implementation
                  mayberesettypeconvs;
                  exit;
                end;
+             nothingn :
+               begin
+                 { generics can generate nothing nodes, just allow everything }
+                 if df_generic in current_procinfo.procdef.defoptions then
+                   result:=true
+                 else if report_errors then
+                   CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
+
+                 mayberesettypeconvs;
+                 exit;
+               end;
              loadn :
                begin
                  case tloadnode(hp).symtableentry.typ of

+ 39 - 3
compiler/pexpr.pas

@@ -2113,6 +2113,22 @@ implementation
          ---------------------------------------------}
 
        procedure factor_read_id(out p1:tnode;var again:boolean);
+
+         function findwithsymtable : boolean;
+           var
+             hp : psymtablestackitem;
+           begin
+             result:=true;
+             hp:=symtablestack.stack;
+             while assigned(hp) do
+               begin
+                 if hp^.symtable.symtabletype=withsymtable then
+                   exit;
+                 hp:=hp^.next;
+               end;
+             result:=false;
+           end;
+
          var
            srsym : tsym;
            srsymtable : TSymtable;
@@ -2192,9 +2208,21 @@ implementation
                            symbol }
                    not (sp_explicitrename in srsym.symoptions) then
                  begin
-                   identifier_not_found(orgstoredpattern);
-                   srsym:=generrorsym;
-                   srsymtable:=nil;
+                   { if a generic is parsed and when we are inside an with block,
+                     a symbol might not be defined }
+                   if (df_generic in current_procinfo.procdef.defoptions) and
+                      findwithsymtable then
+                     begin
+                       { create dummy symbol, it will be freed later on }
+                       srsym:=tsym.create(undefinedsym,'$undefinedsym');
+                       srsymtable:=nil;
+                     end
+                   else
+                     begin
+                       identifier_not_found(orgstoredpattern);
+                       srsym:=generrorsym;
+                       srsymtable:=nil;
+                     end;
                  end;
              end;
 
@@ -2411,6 +2439,14 @@ implementation
                       end;
                   end;
 
+                undefinedsym :
+                  begin
+                    p1:=cnothingnode.Create;
+                    p1.resultdef:=tundefineddef.create;
+                    { clean up previously created dummy symbol }
+                    srsym.free;
+                  end;
+
                 errorsym :
                   begin
                     p1:=cerrornode.create;

+ 18 - 10
compiler/pstatmnt.pas

@@ -534,7 +534,6 @@ implementation
          hp,
          refnode  : tnode;
          hdef : tdef;
-         extendeddef : tabstractrecorddef;
          helperdef : tobjectdef;
          hasimplicitderef : boolean;
          withsymtablelist : TFPObjectList;
@@ -579,7 +578,8 @@ implementation
            to call it in case it returns a record/object/... }
          maybe_call_procvar(p,false);
 
-         if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) then
+         if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) or
+           ((p.resultdef.typ=undefineddef) and (df_generic in current_procinfo.procdef.defoptions)) then
           begin
             newblock:=nil;
             valuenode:=nil;
@@ -660,21 +660,15 @@ implementation
                     valuenode));
                 typecheckpass(refnode);
               end;
-
-            { do we have a helper for this type? }
-            if p.resultdef.typ=classrefdef then
-              extendeddef:=tobjectdef(tclassrefdef(p.resultdef).pointeddef)
-            else
-              extendeddef:=tabstractrecorddef(p.resultdef);
-            search_last_objectpascal_helper(extendeddef,current_structdef,helperdef);
             { Note: the symtable of the helper is pushed after the following
                     "case", the symtables of the helper's parents are passed in
                     the "case" branches }
-
             withsymtablelist:=TFPObjectList.create(true);
             case p.resultdef.typ of
               objectdef :
                 begin
+                   { do we have a helper for this type? }
+                   search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef);
                    { push symtables of all parents in reverse order }
                    pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof);
                    { push symtables of all parents of the helper in reverse order }
@@ -687,6 +681,8 @@ implementation
                  end;
               classrefdef :
                 begin
+                   { do we have a helper for this type? }
+                   search_last_objectpascal_helper(tobjectdef(tclassrefdef(p.resultdef).pointeddef),current_structdef,helperdef);
                    { push symtables of all parents in reverse order }
                    pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof);
                    { push symtables of all parents of the helper in reverse order }
@@ -699,6 +695,8 @@ implementation
                 end;
               recorddef :
                 begin
+                   { do we have a helper for this type? }
+                   search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef);
                    { push symtables of all parents of the helper in reverse order }
                    if assigned(helperdef) then
                      pushobjchild(helperdef,helperdef.childof);
@@ -707,6 +705,16 @@ implementation
                    symtablestack.push(st);
                    withsymtablelist.add(st);
                 end;
+              undefineddef :
+                begin
+                   if not(df_generic in current_procinfo.procdef.defoptions) then
+                     internalerror(2012122802);
+                   helperdef:=nil;
+                   { push record symtable }
+                   st:=twithsymtable.create(p.resultdef,nil,refnode);
+                   symtablestack.push(st);
+                   withsymtablelist.add(st);
+                end;
               else
                 internalerror(200601271);
             end;

+ 2 - 2
compiler/symconst.pas

@@ -548,7 +548,7 @@ type
     staticvarsym,localvarsym,paravarsym,fieldvarsym,
     typesym,procsym,unitsym,constsym,enumsym,
     errorsym,syssym,labelsym,absolutevarsym,propertysym,
-    macrosym,namespacesym
+    macrosym,namespacesym,undefinedsym
   );
 
   { State of the variable:
@@ -662,7 +662,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        'abstractsym','globalvar','localvar','paravar','fieldvar',
        'type','proc','unit','const','enum',
        'errorsym','system sym','label','absolutevar','property',
-       'macrosym','namespace'
+       'macrosym','namespace','undefinedsym'
      );
 
      typName : array[tdeftyp] of string[12] = (

+ 2 - 1
compiler/symtable.pas

@@ -2292,7 +2292,8 @@ implementation
                     exit;
                   end;
               end
-            else
+            else if not((srsymtable.symtabletype=withsymtable) and assigned(srsymtable.defowner) and
+              (srsymtable.defowner.typ=undefineddef)) then
               begin
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) then

+ 24 - 0
tests/test/tgeneric92.pp

@@ -0,0 +1,24 @@
+{$mode objfpc}
+type
+  TRec = record
+    i : longint;
+  end;
+
+  generic TGeneric<T>=class(TObject)
+    procedure Test(v : T);
+  end;
+
+procedure TGeneric.Test(v : T);
+  begin
+    with v do
+      begin
+        i:=1;
+      end;
+  end;
+
+type
+  TC = specialize TGeneric<TRec>;
+
+begin
+end.
+

+ 29 - 0
tests/webtbs/tw21329.pp

@@ -0,0 +1,29 @@
+{$MODE DELPHI}
+{$DEFINE CAUSE_ERROR}
+
+type
+  TArray<T> = array of T;
+
+  TRecord = record end;
+
+  TWrapper<T> = class
+  strict private
+  {$IFDEF CAUSE_ERROR}
+    FRecords: TArray<TRecord>;
+  {$ELSE}
+    FRecords: array of TRecord;
+  {$ENDIF}
+  public
+    constructor Create;
+  end;
+
+constructor TWrapper<T>.Create;
+begin
+  SetLength(FRecords, 1);
+  with FRecords[0] do;
+  // FRecords[0].x:=1;
+end;
+
+begin
+  TWrapper<TRecord>.Create.Free;
+end.