Przeglądaj źródła

Rework the way how "specialize" is handled. Instead of initializing the specialization of a full type declaration (including unit name and parent types) it is now considered part of the specialized type itself. This means that for example the following code:

type
  TTestLongInt = specialize SomeOtherUnit.TTest<LongInt>;

will now have to read as

type
  TTestLongInt = SomeOtherUnit.specialize TTest<LongInt>;

While this is not backwards compatible this situation should arise seldomly enough and the benefits especially in context with generic functions/procedures/methods outway the drawbacks.

pbase.pas:
  * try_consume_unitsym: add a allow_specialize parameter that allows to parse "specialize" in front of a non-unit symbol; whether it was a specialization or not is reported using a new is_specialize parameter
  + add a new overload try_consume_unitsym_no_specialize that calls try_consume_unit sym with allow_specialize=false and a dummy is_specialize parameter
  * switch calls to try_consume_unitsym to try_consume_unitsym_no_specialize
pstatmnt.pas, try_statement:
  * switch call to try_consume_unitsym to try_consume_unitsym_no_specialize
  * adjust call to parse_nested_types
ptype.pas:
  + extend id_type with the possibility to disallow unit symbols (needed if a specialize was already parsed) and to report whether a specialize was parsed
  + extend parse_nested_types with the possibility to tell it whether specializations are allowed
  * have parse_nested_types specialize generic defs if one is encountered and local type defs are allowed
  * id_type: only allow "unitsym.specialize sym" or "specialize sym", but not "specialize unitsym.sym"
  * single_type: correctly handle specializations with "specialize" keyword
  * read_named_type.expr_type: there is no longer a need to check for "specialize" keyword
pexpr.pas:
  + new function handle_specialize_inline_specialization which tries to specialize a type symbol
  * handle_factor_typenode: handle specializations after a point that follows a record or object (why isn't this part of postfixoperators anyway? O.o)
  * postfixoperators: handle "specialize" after records and objectdefs
  * factor_read_id: handle "specialize" in front of an identifier (and after unit symbols)

+ added tests
* adjusted test webtbs/tw16090.pp

git-svn-id: trunk@29768 -
svenbarth 10 lat temu
rodzic
commit
5a344ee263

+ 4 - 0
.gitattributes

@@ -11652,6 +11652,8 @@ tests/test/tgenconstraint8.pp svneol=native#text/pascal
 tests/test/tgenconstraint9.pp svneol=native#text/pascal
 tests/test/tgenconstraint9.pp svneol=native#text/pascal
 tests/test/tgeneric1.pp svneol=native#text/plain
 tests/test/tgeneric1.pp svneol=native#text/plain
 tests/test/tgeneric10.pp svneol=native#text/plain
 tests/test/tgeneric10.pp svneol=native#text/plain
+tests/test/tgeneric100.pp svneol=native#text/pascal
+tests/test/tgeneric101.pp svneol=native#text/pascal
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
@@ -11748,6 +11750,7 @@ tests/test/tgeneric95.pp svneol=native#text/pascal
 tests/test/tgeneric96.pp svneol=native#text/pascal
 tests/test/tgeneric96.pp svneol=native#text/pascal
 tests/test/tgeneric97.pp svneol=native#text/pascal
 tests/test/tgeneric97.pp svneol=native#text/pascal
 tests/test/tgeneric98.pp svneol=native#text/pascal
 tests/test/tgeneric98.pp svneol=native#text/pascal
+tests/test/tgeneric99.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -12395,6 +12398,7 @@ tests/test/ugeneric96a.pp svneol=native#text/pascal
 tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
+tests/test/ugeneric99.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal

+ 22 - 5
compiler/pbase.pas

@@ -89,7 +89,8 @@ interface
     function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
     function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
     function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
     function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
 
 
-    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id,allow_specialize:boolean;out is_specialize:boolean):boolean;
+    function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
 
 
     function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
     function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
 
 
@@ -204,7 +205,7 @@ implementation
           end;
           end;
         searchsym(pattern,srsym,srsymtable);
         searchsym(pattern,srsym,srsymtable);
         { handle unit specification like System.Writeln }
         { handle unit specification like System.Writeln }
-        try_consume_unitsym(srsym,srsymtable,t,true);
+        try_consume_unitsym_no_specialize(srsym,srsymtable,t,true);
         { if nothing found give error and return errorsym }
         { if nothing found give error and return errorsym }
         if assigned(srsym) then
         if assigned(srsym) then
           check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
           check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
@@ -237,7 +238,7 @@ implementation
           end;
           end;
         searchsym(pattern,srsym,srsymtable);
         searchsym(pattern,srsym,srsymtable);
         { handle unit specification like System.Writeln }
         { handle unit specification like System.Writeln }
-        try_consume_unitsym(srsym,srsymtable,t,true);
+        try_consume_unitsym_no_specialize(srsym,srsymtable,t,true);
         { if nothing found give error and return errorsym }
         { if nothing found give error and return errorsym }
         if assigned(srsym) then
         if assigned(srsym) then
           check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
           check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
@@ -253,7 +254,7 @@ implementation
       end;
       end;
 
 
 
 
-    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id,allow_specialize:boolean;out is_specialize:boolean):boolean;
       var
       var
         hmodule: tmodule;
         hmodule: tmodule;
         ns:ansistring;
         ns:ansistring;
@@ -261,6 +262,7 @@ implementation
       begin
       begin
         result:=false;
         result:=false;
         tokentoconsume:=_ID;
         tokentoconsume:=_ID;
+        is_specialize:=false;
 
 
         if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then
         if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then
           begin
           begin
@@ -320,7 +322,15 @@ implementation
                           searchsym_in_module(tunitsym(srsym).module,'ANSICHAR',srsym,srsymtable)
                           searchsym_in_module(tunitsym(srsym).module,'ANSICHAR',srsym,srsymtable)
                       end
                       end
                     else
                     else
-                      searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
+                      if allow_specialize and (idtoken=_SPECIALIZE) then
+                        begin
+                          consume(_ID);
+                          is_specialize:=true;
+                          if token=_ID then
+                            searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
+                        end
+                      else
+                        searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
                   _STRING:
                   _STRING:
                     begin
                     begin
                       { system.string? }
                       { system.string? }
@@ -350,6 +360,13 @@ implementation
       end;
       end;
 
 
 
 
+    function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
+      var
+        dummy: Boolean;
+      begin
+        result:=try_consume_unitsym(srsym,srsymtable,tokentoconsume,consume_id,false,dummy);
+      end;
+
     function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
     function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
       var
       var
         last_is_deprecated:boolean;
         last_is_deprecated:boolean;

+ 208 - 30
compiler/pexpr.pas

@@ -1361,10 +1361,37 @@ implementation
            end;
            end;
       end;
       end;
 
 
+
+    function handle_specialize_inline_specialization(var srsym:tsym;out srsymtable:tsymtable):boolean;
+      var
+        spezdef : tdef;
+      begin
+        result:=false;
+        if not assigned(srsym) then
+          message1(sym_e_id_no_member,orgpattern)
+        else
+          if srsym.typ<>typesym then
+            message(type_e_type_id_expected)
+          else
+            begin
+              spezdef:=ttypesym(srsym).typedef;
+              generate_specialization(spezdef,false,'');
+              if spezdef<>generrordef then
+                begin
+                  srsym:=spezdef.typesym;
+                  srsymtable:=srsym.owner;
+                  check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                  result:=true;
+                end
+            end;
+      end;
+
+
     function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode;
     function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode;
       var
       var
         srsym : tsym;
         srsym : tsym;
         srsymtable : tsymtable;
         srsymtable : tsymtable;
+        isspecialize : boolean;
       begin
       begin
          if sym=nil then
          if sym=nil then
            sym:=hdef.typesym;
            sym:=hdef.typesym;
@@ -1396,12 +1423,37 @@ implementation
                begin
                begin
                  result:=ctypenode.create(hdef);
                  result:=ctypenode.create(hdef);
                  ttypenode(result).typesym:=sym;
                  ttypenode(result).typesym:=sym;
+                 if not (m_delphi in current_settings.modeswitches) and
+                     (block_type in [bt_type,bt_var_type,bt_const_type]) and
+                     (token=_ID) and
+                     (idtoken=_SPECIALIZE) then
+                   begin
+                     consume(_ID);
+                     if token<>_ID then
+                       message(type_e_type_id_expected);
+                     isspecialize:=true;
+                   end
+                 else
+                   isspecialize:=false;
                  { search also in inherited methods }
                  { search also in inherited methods }
                  searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,[ssf_search_helper]);
                  searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,[ssf_search_helper]);
-                 if assigned(srsym) then
-                   check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
-                 consume(_ID);
-                 do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]);
+                 if isspecialize then
+                   begin
+                     consume(_ID);
+                     if not handle_specialize_inline_specialization(srsym,srsymtable) then
+                       begin
+                         result.free;
+                         result:=cerrornode.create;
+                       end;
+                   end
+                 else
+                   begin
+                     if assigned(srsym) then
+                       check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                     consume(_ID);
+                   end;
+                 if result.nodetype<>errorn then
+                   do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]);
                end
                end
              else
              else
               begin
               begin
@@ -1410,17 +1462,42 @@ implementation
                     * static methods and variables }
                     * static methods and variables }
                 result:=ctypenode.create(hdef);
                 result:=ctypenode.create(hdef);
                 ttypenode(result).typesym:=sym;
                 ttypenode(result).typesym:=sym;
+                if not (m_delphi in current_settings.modeswitches) and
+                    (block_type in [bt_type,bt_var_type,bt_const_type]) and
+                    (token=_ID) and
+                    (idtoken=_SPECIALIZE) then
+                  begin
+                    consume(_ID);
+                    if token<>_ID then
+                      message(type_e_type_id_expected);
+                    isspecialize:=true;
+                  end
+                else
+                  isspecialize:=false;
                 { TP allows also @TMenu.Load if Load is only }
                 { TP allows also @TMenu.Load if Load is only }
                 { defined in an anchestor class              }
                 { defined in an anchestor class              }
                 srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
                 srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
-                if assigned(srsym) then
+                if isspecialize then
                   begin
                   begin
-                    check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                     consume(_ID);
                     consume(_ID);
-                    do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]);
+                    if not handle_specialize_inline_specialization(srsym,srsymtable) then
+                      begin
+                        result.free;
+                        result:=cerrornode.create;
+                      end;
                   end
                   end
                 else
                 else
-                  Message1(sym_e_id_no_member,orgpattern);
+                  begin
+                    if assigned(srsym) then
+                      begin
+                        check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                        consume(_ID);
+                      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,[]);
               end;
               end;
            end
            end
          else
          else
@@ -1761,6 +1838,9 @@ implementation
      { shouldn't be used that often, so the extra overhead is ok to save
      { shouldn't be used that often, so the extra overhead is ok to save
        stack space }
        stack space }
      dispatchstring : ansistring;
      dispatchstring : ansistring;
+     erroroutp1,
+     allowspecialize,
+     isspecialize,
      found,
      found,
      haderror,
      haderror,
      nodechanged    : boolean;
      nodechanged    : boolean;
@@ -1973,6 +2053,14 @@ implementation
           _POINT :
           _POINT :
              begin
              begin
                consume(_POINT);
                consume(_POINT);
+               allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in [bt_type,bt_var_type,bt_const_type]);
+               if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
+                 begin
+                   //consume(_ID);
+                   isspecialize:=true;
+                 end
+               else
+                 isspecialize:=false;
                if (p1.resultdef.typ=pointerdef) and
                if (p1.resultdef.typ=pointerdef) and
                   (m_autoderef in current_settings.modeswitches) and
                   (m_autoderef in current_settings.modeswitches) and
                   { don't auto-deref objc.id, because then the code
                   { don't auto-deref objc.id, because then the code
@@ -2105,24 +2193,47 @@ implementation
                case p1.resultdef.typ of
                case p1.resultdef.typ of
                  recorddef:
                  recorddef:
                    begin
                    begin
-                     if token=_ID then
+                     if isspecialize or (token=_ID) then
                        begin
                        begin
+                         erroroutp1:=true;
                          structh:=tabstractrecorddef(p1.resultdef);
                          structh:=tabstractrecorddef(p1.resultdef);
-                         searchsym_in_record(structh,pattern,srsym,srsymtable);
-                         if assigned(srsym) then
+                         if isspecialize then
                            begin
                            begin
-                             check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                             { consume the specialize }
                              consume(_ID);
                              consume(_ID);
-                             do_member_read(structh,getaddr,srsym,p1,again,[]);
+                             if token<>_ID then
+                               consume(_ID)
+                             else
+                               begin
+                                 searchsym_in_record(structh,pattern,srsym,srsymtable);
+                                 consume(_ID);
+                                 if handle_specialize_inline_specialization(srsym,srsymtable) then
+                                   erroroutp1:=false;
+                               end;
                            end
                            end
                          else
                          else
                            begin
                            begin
-                             Message1(sym_e_id_no_member,orgpattern);
-                             p1.destroy;
-                             p1:=cerrornode.create;
-                             { try to clean up }
-                             consume(_ID);
+                             searchsym_in_record(structh,pattern,srsym,srsymtable);
+                             if assigned(srsym) then
+                               begin
+                                 check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                                 consume(_ID);
+                                 erroroutp1:=false;
+                               end
+                             else
+                               begin
+                                 Message1(sym_e_id_no_member,orgpattern);
+                                 { try to clean up }
+                                 consume(_ID);
+                               end;
                            end;
                            end;
+                         if erroroutp1 then
+                           begin
+                             p1.free;
+                             p1:=cerrornode.create;
+                           end
+                         else
+                           do_member_read(structh,getaddr,srsym,p1,again,[]);
                        end
                        end
                      else
                      else
                      consume(_ID);
                      consume(_ID);
@@ -2254,24 +2365,47 @@ implementation
                     end;
                     end;
                   objectdef:
                   objectdef:
                     begin
                     begin
-                      if token=_ID then
+                      if isspecialize or (token=_ID) then
                         begin
                         begin
+                          erroroutp1:=true;
                           structh:=tobjectdef(p1.resultdef);
                           structh:=tobjectdef(p1.resultdef);
-                          searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
-                          if assigned(srsym) then
+                          if isspecialize then
                             begin
                             begin
-                               check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
-                               consume(_ID);
-                               do_member_read(structh,getaddr,srsym,p1,again,[]);
+                              { consume the "specialize" }
+                              consume(_ID);
+                              if token<>_ID then
+                                consume(_ID)
+                              else
+                                begin
+                                  searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
+                                  consume(_ID);
+                                  if handle_specialize_inline_specialization(srsym,srsymtable) then
+                                    erroroutp1:=false;
+                                end;
                             end
                             end
                           else
                           else
                             begin
                             begin
-                               Message1(sym_e_id_no_member,orgpattern);
-                               p1.destroy;
-                               p1:=cerrornode.create;
-                               { try to clean up }
-                               consume(_ID);
+                              searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
+                              if assigned(srsym) then
+                                begin
+                                   check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                                   consume(_ID);
+                                   erroroutp1:=false;
+                                end
+                              else
+                                begin
+                                   Message1(sym_e_id_no_member,orgpattern);
+                                   { try to clean up }
+                                   consume(_ID);
+                                end;
                             end;
                             end;
+                          if erroroutp1 then
+                            begin
+                              p1.free;
+                              p1:=cerrornode.create;
+                            end
+                          else
+                            do_member_read(structh,getaddr,srsym,p1,again,[]);
                         end
                         end
                       else { Error }
                       else { Error }
                         Consume(_ID);
                         Consume(_ID);
@@ -2449,6 +2583,8 @@ implementation
            storedpattern: string;
            storedpattern: string;
            callflags: tcallnodeflags;
            callflags: tcallnodeflags;
            t : ttoken;
            t : ttoken;
+           allowspecialize,
+           isspecialize,
            unit_found : boolean;
            unit_found : boolean;
            tokenpos: tfileposinfo;
            tokenpos: tfileposinfo;
          begin
          begin
@@ -2459,6 +2595,15 @@ implementation
            tokenpos:=current_filepos;
            tokenpos:=current_filepos;
            p1:=nil;
            p1:=nil;
 
 
+           allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in [bt_type,bt_var_type,bt_const_type]);
+           if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
+             begin
+               consume(_ID);
+               isspecialize:=true;
+             end
+           else
+             isspecialize:=false;
+
            { first check for identifier }
            { first check for identifier }
            if token<>_ID then
            if token<>_ID then
              begin
              begin
@@ -2474,7 +2619,13 @@ implementation
                else
                else
                  searchsym(pattern,srsym,srsymtable);
                  searchsym(pattern,srsym,srsymtable);
                { handle unit specification like System.Writeln }
                { handle unit specification like System.Writeln }
-               unit_found:=try_consume_unitsym(srsym,srsymtable,t,true);
+               if not isspecialize then
+                 unit_found:=try_consume_unitsym(srsym,srsymtable,t,true,allowspecialize,isspecialize)
+               else
+                 begin
+                   unit_found:=false;
+                   t:=_ID;
+                 end;
                storedpattern:=pattern;
                storedpattern:=pattern;
                orgstoredpattern:=orgpattern;
                orgstoredpattern:=orgpattern;
                { store the position of the token before consuming it }
                { store the position of the token before consuming it }
@@ -2484,6 +2635,7 @@ implementation
                found_arg_name:=false;
                found_arg_name:=false;
 
 
                if not(unit_found) and
                if not(unit_found) and
+                   not isspecialize and
                   named_args_allowed and
                   named_args_allowed and
                   (token=_ASSIGNMENT) then
                   (token=_ASSIGNMENT) then
                   begin
                   begin
@@ -2493,6 +2645,32 @@ implementation
                     exit;
                     exit;
                   end;
                   end;
 
 
+               if isspecialize then
+                 begin
+                   if not assigned(srsym) or
+                       (srsym.typ<>typesym) then
+                     begin
+                       identifier_not_found(orgstoredpattern,tokenpos);
+                       srsym:=generrorsym;
+                       srsymtable:=nil;
+                     end
+                   else
+                     begin
+                       hdef:=ttypesym(srsym).typedef;
+                       generate_specialization(hdef,false,'');
+                       if hdef=generrordef then
+                         begin
+                           srsym:=generrorsym;
+                           srsymtable:=nil;
+                         end
+                       else
+                         begin
+                           srsym:=hdef.typesym;
+                           srsymtable:=srsym.owner;
+                         end;
+                     end;
+                 end;
+
                { check hints, but only if it isn't a potential generic symbol;
                { check hints, but only if it isn't a potential generic symbol;
                  that is checked in sub_expr if it isn't a generic }
                  that is checked in sub_expr if it isn't a generic }
                if assigned(srsym) and
                if assigned(srsym) and

+ 2 - 2
compiler/pstatmnt.pas

@@ -948,7 +948,7 @@ implementation
                                  with "e: Exception" the e is not necessary }
                                  with "e: Exception" the e is not necessary }
 
 
                                { support unit.identifier }
                                { support unit.identifier }
-                               unit_found:=try_consume_unitsym(srsym,srsymtable,t,false);
+                               unit_found:=try_consume_unitsym_no_specialize(srsym,srsymtable,t,false);
                                if srsym=nil then
                                if srsym=nil then
                                  begin
                                  begin
                                    identifier_not_found(orgpattern);
                                    identifier_not_found(orgpattern);
@@ -961,7 +961,7 @@ implementation
                                if (srsym.typ=typesym) then
                                if (srsym.typ=typesym) then
                                  begin
                                  begin
                                    ot:=ttypesym(srsym).typedef;
                                    ot:=ttypesym(srsym).typedef;
-                                   parse_nested_types(ot,false,nil);
+                                   parse_nested_types(ot,false,false,nil);
                                    check_type_valid(ot);
                                    check_type_valid(ot);
                                  end
                                  end
                                else
                                else

+ 45 - 18
compiler/ptype.pas

@@ -50,7 +50,7 @@ interface
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
 
 
     { parse nested type declaration of the def (typedef) }
     { parse nested type declaration of the def (typedef) }
-    procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist);
+    procedure parse_nested_types(var def: tdef; isforwarddef,allowspecialization: boolean; currentstructstack: tfpobjectlist);
 
 
 
 
     { add a definition for a method to a record/objectdef that will contain
     { add a definition for a method to a record/objectdef that will contain
@@ -200,7 +200,7 @@ implementation
       end;
       end;
 
 
 
 
-    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); forward;
+    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean); forward;
 
 
 
 
     { def is the outermost type in which other types have to be searched
     { def is the outermost type in which other types have to be searched
@@ -213,13 +213,14 @@ implementation
       being parsed (so using id_type on them after pushing def on the
       being parsed (so using id_type on them after pushing def on the
       symtablestack would result in errors because they'd come back as errordef)
       symtablestack would result in errors because they'd come back as errordef)
     }
     }
-    procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist);
+    procedure parse_nested_types(var def: tdef; isforwarddef,allowspecialization: boolean; currentstructstack: tfpobjectlist);
       var
       var
         t2: tdef;
         t2: tdef;
         structstackindex: longint;
         structstackindex: longint;
         srsym: tsym;
         srsym: tsym;
         srsymtable: tsymtable;
         srsymtable: tsymtable;
         oldsymtablestack: TSymtablestack;
         oldsymtablestack: TSymtablestack;
+        isspecialize : boolean;
       begin
       begin
         if assigned(currentstructstack) then
         if assigned(currentstructstack) then
           structstackindex:=currentstructstack.count-1
           structstackindex:=currentstructstack.count-1
@@ -247,10 +248,16 @@ implementation
                      symtablestack:=TSymtablestack.create;
                      symtablestack:=TSymtablestack.create;
                      symtablestack.push(tabstractrecorddef(def).symtable);
                      symtablestack.push(tabstractrecorddef(def).symtable);
                      t2:=generrordef;
                      t2:=generrordef;
-                     id_type(t2,isforwarddef,false,false,srsym,srsymtable);
+                     id_type(t2,isforwarddef,false,false,false,srsym,srsymtable,isspecialize);
                      symtablestack.pop(tabstractrecorddef(def).symtable);
                      symtablestack.pop(tabstractrecorddef(def).symtable);
                      symtablestack.free;
                      symtablestack.free;
                      symtablestack:=oldsymtablestack;
                      symtablestack:=oldsymtablestack;
+                     if isspecialize then
+                       begin
+                         if not allowspecialization then
+                           Message(parser_e_no_local_para_def);
+                         generate_specialization(t2,false,'');
+                       end;
                      def:=t2;
                      def:=t2;
                    end;
                    end;
                end
                end
@@ -285,7 +292,7 @@ implementation
                      structdefstack.add(structdef);
                      structdefstack.add(structdef);
                      structdef:=tabstractrecorddef(structdef.owner.defowner);
                      structdef:=tabstractrecorddef(structdef.owner.defowner);
                    end;
                    end;
-                 parse_nested_types(def,isfowarddef,structdefstack);
+                 parse_nested_types(def,isfowarddef,false,structdefstack);
                  structdefstack.free;
                  structdefstack.free;
                  result:=true;
                  result:=true;
                  exit;
                  exit;
@@ -295,7 +302,7 @@ implementation
          result:=false;
          result:=false;
       end;
       end;
 
 
-    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable);
+    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean);
     { reads a type definition }
     { reads a type definition }
     { to a appropriating tdef, s gets the name of   }
     { to a appropriating tdef, s gets the name of   }
     { the type to allow name mangling          }
     { the type to allow name mangling          }
@@ -307,6 +314,7 @@ implementation
       begin
       begin
          srsym:=nil;
          srsym:=nil;
          srsymtable:=nil;
          srsymtable:=nil;
+         is_specialize:=false;
          s:=pattern;
          s:=pattern;
          sorg:=orgpattern;
          sorg:=orgpattern;
          pos:=current_tokenpos;
          pos:=current_tokenpos;
@@ -315,6 +323,14 @@ implementation
          if checkcurrentrecdef and
          if checkcurrentrecdef and
             try_parse_structdef_nested_type(def,current_structdef,isforwarddef) then
             try_parse_structdef_nested_type(def,current_structdef,isforwarddef) then
            exit;
            exit;
+         if not allowunitsym and (idtoken=_SPECIALIZE) then
+           begin
+             consume(_ID);
+             is_specialize:=true;
+             s:=pattern;
+             sorg:=orgpattern;
+             pos:=current_tokenpos;
+           end;
          { Use the special searchsym_type that search only types }
          { Use the special searchsym_type that search only types }
          if not searchsym_type(s,srsym,srsymtable) then
          if not searchsym_type(s,srsym,srsymtable) then
            { for a good error message we need to know whether the symbol really did not exist or
            { for a good error message we need to know whether the symbol really did not exist or
@@ -323,7 +339,13 @@ implementation
          else
          else
            not_a_type:=false;
            not_a_type:=false;
          { handle unit specification like System.Writeln }
          { handle unit specification like System.Writeln }
-         is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true);
+         if allowunitsym then
+           is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true,true,is_specialize)
+         else
+           begin
+             t:=_ID;
+             is_unit_specific:=false;
+           end;
          consume(t);
          consume(t);
          if not_a_type then
          if not_a_type then
            begin
            begin
@@ -399,6 +421,7 @@ implementation
     procedure single_type(var def:tdef;options:TSingleTypeOptions);
     procedure single_type(var def:tdef;options:TSingleTypeOptions);
        var
        var
          t2 : tdef;
          t2 : tdef;
+         isspecialize,
          dospecialize,
          dospecialize,
          again : boolean;
          again : boolean;
          srsym : tsym;
          srsym : tsym;
@@ -450,8 +473,12 @@ implementation
                      end
                      end
                    else
                    else
                      begin
                      begin
-                       id_type(def,stoIsForwardDef in options,true,true,srsym,srsymtable);
-                       parse_nested_types(def,stoIsForwardDef in options,nil);
+                       id_type(def,stoIsForwardDef in options,true,true,not dospecialize or ([stoAllowSpecialization,stoAllowTypeDef]*options=[]),srsym,srsymtable,isspecialize);
+                       if isspecialize and dospecialize then
+                         internalerror(2015021301);
+                       if isspecialize then
+                         dospecialize:=true;
+                       parse_nested_types(def,stoIsForwardDef in options,[stoAllowSpecialization,stoAllowTypeDef]*options<>[],nil);
                      end;
                      end;
                  end;
                  end;
 
 
@@ -480,7 +507,7 @@ implementation
             if def.typ=forwarddef then
             if def.typ=forwarddef then
               def:=ttypesym(srsym).typedef;
               def:=ttypesym(srsym).typedef;
             generate_specialization(def,stoParseClassParent in options,'');
             generate_specialization(def,stoParseClassParent in options,'');
-            parse_nested_types(def,stoIsForwardDef in options,nil);
+            parse_nested_types(def,stoIsForwardDef in options,[stoAllowSpecialization,stoAllowTypeDef]*options<>[],nil);
           end
           end
         else
         else
           begin
           begin
@@ -979,12 +1006,9 @@ implementation
            if (token=_ID) then
            if (token=_ID) then
              if try_parse_structdef_nested_type(def,current_structdef,false) then
              if try_parse_structdef_nested_type(def,current_structdef,false) then
                exit;
                exit;
-           { Generate a specialization in FPC mode? }
-           dospecialize:=not(m_delphi in current_settings.modeswitches) and try_to_consume(_SPECIALIZE);
            { we can't accept a equal in type }
            { we can't accept a equal in type }
            pt1:=comp_expr(false,true);
            pt1:=comp_expr(false,true);
-           if not dospecialize and
-              try_to_consume(_POINTPOINT) then
+           if try_to_consume(_POINTPOINT) then
              begin
              begin
                { get high value of range }
                { get high value of range }
                pt2:=comp_expr(false,false);
                pt2:=comp_expr(false,false);
@@ -1040,10 +1064,13 @@ implementation
                    if (m_delphi in current_settings.modeswitches) then
                    if (m_delphi in current_settings.modeswitches) then
                      dospecialize:=token=_LSHARPBRACKET
                      dospecialize:=token=_LSHARPBRACKET
                    else
                    else
-                     { in non-Delphi modes we might get a inline specialization
-                       without "specialize" or "<T>" of the same type we're
-                       currently parsing, so we need to handle that special }
-                     newdef:=nil;
+                     begin
+                       dospecialize:=false;
+                       { in non-Delphi modes we might get a inline specialization
+                         without "specialize" or "<T>" of the same type we're
+                         currently parsing, so we need to handle that special }
+                       newdef:=nil;
+                     end;
                    if not dospecialize and
                    if not dospecialize and
                        assigned(ttypenode(pt1).typesym) and
                        assigned(ttypenode(pt1).typesym) and
                        (ttypenode(pt1).typesym.typ=typesym) and
                        (ttypenode(pt1).typesym.typ=typesym) and

+ 15 - 0
tests/test/tgeneric100.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+
+program tgeneric100;
+
+{$mode objfpc}
+
+uses
+  ugeneric99;
+
+type
+  TTest1 = specialize ugeneric99.TTest<LongInt>;
+
+begin
+
+end.

+ 15 - 0
tests/test/tgeneric101.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+
+program tgeneric101;
+
+{$mode objfpc}
+
+uses
+  ugeneric99;
+
+type
+  TTest1 = specialize TTestClass.TTest<LongInt>;
+
+begin
+
+end.

+ 55 - 0
tests/test/tgeneric99.pp

@@ -0,0 +1,55 @@
+{ %NORUN }
+
+program tgeneric99;
+
+{$mode objfpc}
+
+uses
+  ugeneric99;
+
+type
+  TTest1 = specialize TTest<LongInt>;
+  TTest2 = ugeneric99.specialize TTest<LongInt>;
+
+  TTest3 = TTestClass.specialize TTest<LongInt>;
+  TTest4 = ugeneric99.TTestClass.specialize TTest<LongInt>;
+
+  TTest5 = TTestRec.specialize TTest<LongInt>;
+  TTest6 = ugeneric99.TTestRec.specialize TTest<LongInt>;
+
+var
+  test1: specialize TTestArray<LongInt>;
+  test2: ugeneric99.specialize TTestArray<LongInt>;
+
+  test3: ugeneric99.TTestClass.specialize TTestArray<LongInt>;
+  test4: ugeneric99.TTestRec.specialize TTestArray<LongInt>;
+
+  test5: ugeneric99.TTestClass.specialize TTest<LongInt>.TTestRec;
+  test6: ugeneric99.TTestRec.specialize TTest<LongInt>.TTestClass;
+
+procedure Proc1(aArg: specialize TTestArray<LongInt>);
+begin
+end;
+
+procedure Proc2(aArg: ugeneric99.specialize TTestArray<LongInt>);
+begin
+end;
+
+procedure Proc3(aArg: ugeneric99.TTestClass.specialize TTestArray<LongInt>);
+begin
+end;
+
+procedure Proc4(aArg: ugeneric99.TTestRec.specialize TTestArray<LongInt>);
+begin
+end;
+
+procedure Proc5(aArg: ugeneric99.TTestClass.specialize TTest<LongInt>.TTestRec);
+begin
+end;
+
+procedure Proc6(aArg: ugeneric99.TTestRec.specialize TTest<LongInt>.TTestClass);
+begin
+end;
+
+begin
+end.

+ 47 - 0
tests/test/ugeneric99.pp

@@ -0,0 +1,47 @@
+unit ugeneric99;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+type
+  generic TTest<T> = class
+  type
+    TTestT = specialize TTest<T>;
+  end;
+
+  TTestRec = record
+    f: LongInt;
+    type
+      generic TTest<T> = class
+        type
+          TTestClass = class
+          end;
+      end;
+
+      generic TTestArray<T> = array of T;
+    var
+      t: specialize TTest<LongInt>.TTestClass;
+  end;
+
+  TTestClass = class
+    type
+      generic TTest<T> = class
+        type
+          TTestRec = record
+            f: LongInt;
+          end;
+      end;
+
+      generic TTestArray<T> = array of T;
+   var
+      t: specialize TTest<LongInt>.TTestRec;
+  end;
+
+  generic TTestArray<T> = array of T;
+
+implementation
+
+end.
+

+ 1 - 1
tests/webtbs/tw16090.pp

@@ -14,7 +14,7 @@ type
   end;
   end;
 
 
   // Fatal: Internal error 200705152
   // Fatal: Internal error 200705152
-  TSpecialization1 = specialize TClass1.TNestedClass<Integer>;
+  TSpecialization1 = TClass1.specialize TNestedClass<Integer>;
 
 
 begin
 begin
 end.
 end.