Allow generics to be overloaded by variables.

* symconst.pas:
   add an entry for the generic dummy symbol to the symbol options enumeration
* pgenutil.pas:
   - extend "generate_specialization" by the possibility to pass a symbol name instead of a def
   - if "symname" is given that is used; otherwise "genericdef" or "tt" is used
* pexpr.pas:
   - in case of "<" we are trying to receive a generic dummy symbol from the left node (new function "getgenericsym")
   - it's name is then passed to "generate_specialization" which in turn fills genericdef
   - adjust call to "generate_specialization"
* pdecl.pas:
   - we can now check for "sp_generic_dummy instead of "not sp_generic_para" to check whether we've found the dummy symbol of a previous generic declaration
   - if a new dummy symbol is created we need to include "sp_generic_dummy"
   - if we've found a non-generic symbol with the same name we need to include the "sp_generic_dummy" flag as well
* symtable.pas
   - add a new function "searchsym_with_symoption" that more or less works the same as "searchsym", but only returns successfully if the found symbol contains the given flag
   - "searchsym_with_symoption" and "searchsym" are based on the same function "maybe_searchsym_with_symoption" which is the extended implementation of "searchsym" (note: object symtables are not yet searched if a symoption is to be looked for)
   - add a function "handle_generic_dummysym" which can be used to hide the undefineddef symbol in a symtable
   - correctly handle generic dummy symbols in case of variables in "tstaticsymtable.checkduplicate"

git-svn-id: branches/svenbarth/generics@19429 -

compiler/pdecl.pas

@@ -439,7 +439,7 @@ implementation
                    that was declared earlier }
                  not (
                    (ttypesym(sym).typedef.typ=undefineddef) and
-                   not (sp_generic_para in sym.symoptions)
+                   (sp_generic_dummy in sym.symoptions)
                  ) then
                begin
                  if ((token=_CLASS) or
@@ -499,6 +499,7 @@ implementation
                   if not assigned(sym) then
                     begin
                       sym:=ttypesym.create(orgtypename,tundefineddef.create);
+                      Include(sym.symoptions,sp_generic_dummy);
                       ttypesym(sym).typedef.typesym:=sym;
                       sym.visibility:=symtablestack.top.currentvisibility;
                       symtablestack.top.insert(sym);
@@ -507,13 +508,17 @@ implementation
                   else
                     { this is not allowed in non-Delphi modes }
                     if not (m_delphi in current_settings.modeswitches) then
-                      Message1(sym_e_duplicate_id,genorgtypename);
+                      Message1(sym_e_duplicate_id,genorgtypename)
+                    else
+                      { we need to find this symbol even if it's a variable or
+                        something else when doing an inline specialization }
+                      Include(sym.symoptions,sp_generic_dummy);
                 end
               else
                 begin
                   if assigned(sym) and (sym.typ=typesym) and
                       (ttypesym(sym).typedef.typ=undefineddef) and
-                      not (sp_generic_para in sym.symoptions) then
+                      (sp_generic_dummy in sym.symoptions) then
                     begin
                       { this is a symbol that was added by an earlier generic
                         declaration, reuse it }

compiler/pexpr.pas

@@ -2896,12 +2896,31 @@ implementation
             result:=ttypenode(tloadvmtaddrnode(n).left).typedef;
         end;
 
+      function getgenericsym(n:tnode;out srsym:tsym):boolean;
+        var
+          srsymtable : tsymtable;
+        begin
+          srsym:=nil;
+          case n.nodetype of
+            typen:
+              srsym:=ttypenode(n).typedef.typesym;
+            loadvmtaddrn:
+              srsym:=ttypenode(tloadvmtaddrnode(n).left).typedef.typesym;
+            loadn:
+              if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
+                srsym:=nil;
+            { TODO : handle const nodes }
+          end;
+          result:=assigned(srsym);
+        end;
+
       var
         p1,p2   : tnode;
         oldt    : Ttoken;
         filepos : tfileposinfo;
         again   : boolean;
         gendef,parseddef : tdef;
+        gensym : tsym;
       begin
         if pred_level=highest_precedence then
           p1:=factor(false,typeonly)
@@ -2941,18 +2960,20 @@ implementation
                             same name is defined in the same unit where the
                             generic is defined (though "same unit" is not
                             necessarily needed) }
-                   if istypenode(p1) and istypenode(p2) and
+                   if getgenericsym(p1,gensym) and
+                      { Attention: when nested specializations are supported
+                                   p2 could be a loadn if a "<" follows }
+                      istypenode(p2) and
                        (m_delphi in current_settings.modeswitches) and
+                       { TODO : add _LT, _LSHARPBRACKET for nested specializations }
                        (token in [_GT,_RSHARPBRACKET,_COMMA]) then
                      begin
                        { this is an inline specialization }
 
                        { retrieve the defs of two nodes }
-                       gendef:=gettypedef(p1);
+                       gendef:=nil;
                        parseddef:=gettypedef(p2);
 
-                       if gendef.typesym.typ<>typesym then
-                         Internalerror(2011050301);
                        if parseddef.typesym.typ<>typesym then
                          Internalerror(2011051001);
 
@@ -2960,7 +2981,7 @@ implementation
                        check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg);
 
                        { generate the specialization }
-                       generate_specialization(gendef,false,parseddef);
+                       generate_specialization(gendef,false,parseddef,gensym.RealName);
 
                        { we don't need the old left and right nodes anymore }
                        p1.Free;
@@ -3041,7 +3062,7 @@ implementation
                          Internalerror(2011071401);
 
                        { generate the specialization }
-                       generate_specialization(gendef,false,nil);
+                       generate_specialization(gendef,false,nil,'');
 
                        { we don't need the old p2 anymore }
                        p2.Free;

compiler/pgenutil.pas

@@ -32,7 +32,7 @@ uses
   { symtable }
   symtype,symdef;
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;parsedtype:tdef);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;parsedtype:tdef;symname:string);
     function parse_generic_parameters:TFPObjectList;
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
 
@@ -55,7 +55,7 @@ uses
   pbase,pexpr,pdecsub,ptype;
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;parsedtype:tdef);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;parsedtype:tdef;symname:string);
       var
         st  : TSymtable;
         srsym : tsym;
@@ -65,7 +65,6 @@ uses
         i,
         gencount : longint;
         genericdef : tstoreddef;
-        genericsym,
         generictype : ttypesym;
         genericdeflist : TFPObjectList;
         generictypelist : TFPObjectList;
@@ -85,12 +84,13 @@ uses
         tt:=nil;
         onlyparsepara:=false;
 
-        if not assigned(genericdef.typesym) or
+        { either symname must be given or genericdef needs to be valid }
-            (genericdef.typesym.typ<>typesym) then
+        if (symname='') and
+            (not assigned(genericdef) or
+            not assigned(genericdef.typesym) or
+            (genericdef.typesym.typ<>typesym)) then
            internalerror(2011042701);
 
-        genericsym:=ttypesym(genericdef.typesym);
-
         { only need to record the tokens, then we don't know the type yet  ... }
         if parse_generic then
           begin
@@ -117,7 +117,7 @@ uses
             consume(_RSHARPBRACKET);
             if parse_generic and parse_class_parent then
               begin
-                if df_generic in genericdef.defoptions then
+                if (symname='') and (df_generic in genericdef.defoptions) then
                   { this happens in non-Delphi modes }
                   tt:=genericdef
                 else
@@ -125,7 +125,11 @@ uses
                     { find the corresponding generic symbol so that any checks
                       done on the returned def will be handled correctly }
                     str(gencount,countstr);
-                    genname:=ttypesym(genericdef.typesym).realname+'$'+countstr;
+                    if symname='' then
+                      genname:=ttypesym(genericdef.typesym).realname
+                    else
+                      genname:=symname;
+                    genname:=symname+'$'+countstr;
                     ugenname:=upper(genname);
                     if not searchsym(ugenname,srsym,st) or
                         (srsym.typ<>typesym) then
@@ -146,8 +150,6 @@ uses
         genericdeflist:=TFPObjectList.Create(false);
 
         { Parse type parameters }
-        if not assigned(genericdef.typesym) then
-          internalerror(200710173);
         err:=false;
         { if parsedtype is set, then the first type identifer was already parsed
           (happens in inline specializations) and thus we only need to parse
@@ -196,10 +198,13 @@ uses
         str(genericdeflist.Count,countstr);
         { use the name of the symbol as procvars return a user friendly version
           of the name }
-        genname:=ttypesym(genericdef.typesym).realname;
+        if symname='' then
+          genname:=ttypesym(genericdef.typesym).realname
+        else
+          genname:=symname;
         { in case of non-Delphi mode the type name could already be a generic
           def (but maybe the wrong one) }
-        if df_generic in genericdef.defoptions then
+        if assigned(genericdef) and (df_generic in genericdef.defoptions) then
           begin
             { remove the type count suffix from the generic's name }
             for i:=Length(genname) downto 1 do

compiler/ptype.pas

@@ -370,7 +370,7 @@ implementation
            (m_delphi in current_settings.modeswitches) then
           dospecialize:=token=_LSHARPBRACKET;
         if dospecialize then
-          generate_specialization(def,stoParseClassParent in options,nil)
+          generate_specialization(def,stoParseClassParent in options,nil,'')
         else
           begin
             if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
@@ -839,7 +839,7 @@ implementation
                      dospecialize:=token=_LSHARPBRACKET;
                    if dospecialize then
                      begin
-                       generate_specialization(def,false,nil);
+                       generate_specialization(def,false,nil,'');
                        { handle nested types }
                        post_comp_expr_gendef(def);
                      end

compiler/symconst.pas

@@ -167,7 +167,11 @@ type
     sp_implicitrename,
     sp_hint_experimental,
     sp_generic_para,
-    sp_has_deprecated_msg
+    sp_has_deprecated_msg,
+    sp_generic_dummy        { this is used for symbols that are generated when a
+                              generic is encountered to ease inline
+                              specializations, etc; those symbols can be
+                              "overridden" with a completely different symbol }
   );
   tsymoptions=set of tsymoption;
 

compiler/symtable.pas

@@ -209,6 +209,7 @@ interface
     procedure incompatibletypes(def1,def2:tdef);
     procedure hidesym(sym:TSymEntry);
     procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
+    function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
 
 {*** Search ***}
     procedure addsymref(sym:tsym);
@@ -217,6 +218,10 @@ interface
     function  is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
     function  is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+    function  searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
+    { searches for a symbol with the given name that has the given option in
+      symoptions set }
+    function  searchsym_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;option:tsymoption):boolean;
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
@@ -1479,6 +1484,8 @@ implementation
         hsym:=tsym(FindWithHash(hashedid));
         if assigned(hsym) then
           begin
+            if (sym is tstoredsym) and handle_generic_dummysym(hsym,tstoredsym(sym).symoptions) then
+              exit;
             { Delphi (contrary to TP) you can have a symbol with the same name as the
               unit, the unit can then not be accessed anymore using
               <unit>.<id>, so we can hide the symbol }
@@ -1755,6 +1762,29 @@ implementation
           include(tsym(dupsym).symoptions,sp_implicitrename);
       end;
 
+    function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
+      begin
+        result:=false;
+        if not assigned(sym) or not (sym is tstoredsym) then
+          Internalerror(2011081101);
+        { For generics a dummy symbol without the parameter count is created
+          if such a symbol not yet exists so that different parts of the
+          parser can find that symbol. If that symbol is still a
+          undefineddef we replace the generic dummy symbol's
+          name with a "dup" name and use the new symbol as the generic dummy
+          symbol }
+        if (sp_generic_dummy in tstoredsym(sym).symoptions) and
+            (sym.typ=typesym) and (ttypesym(sym).typedef.typ=undefineddef) and
+            (m_delphi in current_settings.modeswitches) then
+          begin
+            inc(dupnr);
+            sym.Owner.SymList.Rename(upper(sym.realname),'dup_'+tostr(dupnr)+sym.realname);
+            include(tsym(sym).symoptions,sp_implicitrename);
+            { we need to find the new symbol now if checking for a dummy }
+            include(symoptions,sp_generic_dummy);
+            result:=true;
+          end;
+      end;
 
 {*****************************************************************************
                                   Search
@@ -1911,6 +1941,11 @@ implementation
 
 
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+      begin
+        result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,false,sp_none);
+      end;
+
+    function  searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
       var
         hashedid   : THashedIDString;
         contextstructdef : tabstractrecorddef;
@@ -1924,6 +1959,12 @@ implementation
             srsymtable:=stackitem^.symtable;
             if (srsymtable.symtabletype=objectsymtable) then
               begin
+                { TODO : implement the search for an option in classes as well }
+                if searchoption then
+                  begin
+                    result:=false;
+                    exit;
+                  end;
                 if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
                   begin
                     result:=true;
@@ -1946,7 +1987,8 @@ implementation
                     else
                       contextstructdef:=current_structdef;
                     if not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or
-                       is_visible_for_object(srsym,contextstructdef) then
+                       is_visible_for_object(srsym,contextstructdef) and
+                       (not searchoption or (option in srsym.symoptions)) then
                       begin
                         { we need to know if a procedure references symbols
                           in the static symtable, because then it can't be
@@ -1966,6 +2008,11 @@ implementation
         srsymtable:=nil;
       end;
 
+    function searchsym_with_symoption(const s: TIDString;out srsym:tsym;out
+      srsymtable:TSymtable;option:tsymoption):boolean;
+      begin
+        result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,true,option);
+      end;
 
     function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var