瀏覽代碼

* several fixes which improve the behaviour of nested generics, resolves #15077

git-svn-id: trunk@14176 -
florian 15 年之前
父節點
當前提交
5d01732128
共有 6 個文件被更改,包括 76 次插入25 次删除
  1. 1 0
      .gitattributes
  2. 1 10
      compiler/defcmp.pas
  3. 6 3
      compiler/ptype.pas
  4. 42 9
      compiler/scanner.pas
  5. 3 3
      compiler/symdef.pas
  6. 23 0
      tests/test/tgeneric18.pp

+ 1 - 0
.gitattributes

@@ -8862,6 +8862,7 @@ tests/test/tgeneric14.pp svneol=native#text/plain
 tests/test/tgeneric15.pp svneol=native#text/plain
 tests/test/tgeneric16.pp svneol=native#text/plain
 tests/test/tgeneric17.pp svneol=native#text/plain
+tests/test/tgeneric18.pp svneol=native#text/pascal
 tests/test/tgeneric2.pp svneol=native#text/plain
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain

+ 1 - 10
compiler/defcmp.pas

@@ -198,16 +198,7 @@ implementation
             (def_to.typ=undefineddef) then
           begin
             doconv:=tc_equal;
-            compare_defs_ext:=te_equal;
-            exit;
-          end;
-
-         { undefined def? then mark it as equal }
-         if (def_from.typ=undefineddef) or
-            (def_to.typ=undefineddef) then
-          begin
-            doconv:=tc_equal;
-            compare_defs_ext:=te_equal;
+            compare_defs_ext:=te_exact;
             exit;
           end;
 

+ 6 - 3
compiler/ptype.pas

@@ -141,7 +141,6 @@ implementation
       end;
 
 
-
     procedure generate_specialization(var tt:tdef);
       var
         st  : TSymtable;
@@ -175,10 +174,13 @@ implementation
             onlyparsepara:=true;
           end;
 
-        { Only need to record the tokens, then we don't know the type yet }
+        { only need to record the tokens, then we don't know the type yet  ... }
         if parse_generic then
           begin
-            tt:=cundefinedtype;
+            { ... but we have to insert a def into the symtable else the deflist
+              of generic and specialization might not be equally sized which
+              is later assumed }
+            tt:=tundefineddef.create;
             onlyparsepara:=true;
           end;
 
@@ -317,6 +319,7 @@ implementation
                 { Consume the semicolon if it is also recorded }
                 try_to_consume(_SEMICOLON);
 
+
                 { Build VMT indexes for classes }
                 if (tt.typ=objectdef) then
                   begin

+ 42 - 9
compiler/scanner.pas

@@ -65,6 +65,15 @@ interface
           constructor CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
        end;
 
+       // stack for replay buffers
+       treplaystack = class
+         token    : ttoken;
+         settings : tsettings;
+         tokenbuf : tdynamicarray;
+         next     : treplaystack;
+         constructor Create(atoken: ttoken;asettings:tsettings;atokenbuf:tdynamicarray;anext:treplaystack);
+       end;
+
        tcompile_time_predicate = function(var valuedescr: String) : Boolean;
 
        tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX);
@@ -97,12 +106,9 @@ interface
           oldcurrent_tokenpos : tfileposinfo;
 
 
-          replaysavetoken : ttoken;
           replaytokenbuf,
           recordtokenbuf : tdynamicarray;
 
-          { old settings, i.e. settings specialization was started }
-          old_settings,
           { last settings we stored }
           last_settings : tsettings;
 
@@ -116,6 +122,7 @@ interface
           lastasmgetchar : char;
           ignoredirectives : TFPHashList; { ignore directives, used to give warnings only once }
           preprocstack   : tpreprocstack;
+          replaystack    : treplaystack;
           in_asm_string  : boolean;
 
           preproc_pattern : string;
@@ -146,6 +153,7 @@ interface
           procedure ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint);
           procedure elseifpreprocstack(compile_time_predicate:tcompile_time_predicate);
           procedure elsepreprocstack;
+          procedure popreplaystack;
           procedure handleconditional(p:tdirectiveitem);
           procedure handledirectives;
           procedure linebreak;
@@ -1818,6 +1826,16 @@ In case not, the value returned can be arbitrary.
         next:=n;
       end;
 
+{*****************************************************************************
+                              TReplayStack
+*****************************************************************************}
+    constructor treplaystack.Create(atoken:ttoken;asettings:tsettings;atokenbuf:tdynamicarray;anext:treplaystack);
+      begin
+        token:=atoken;
+        settings:=asettings;
+        tokenbuf:=atokenbuf;
+        next:=anext;
+      end;
 
 {*****************************************************************************
                               TDirectiveItem
@@ -1853,6 +1871,7 @@ In case not, the value returned can be arbitrary.
         inputstart:=0;
       { reset scanner }
         preprocstack:=nil;
+        replaystack:=nil;
         comment_level:=0;
         yylexcount:=0;
         block_type:=bt_general;
@@ -1888,6 +1907,8 @@ In case not, the value returned can be arbitrary.
             while assigned(preprocstack) do
              poppreprocstack;
           end;
+        while assigned(replaystack) do
+          popreplaystack;
         if not inputfile.closed then
           closeinputfile;
         ignoredirectives.free;
@@ -2094,8 +2115,7 @@ In case not, the value returned can be arbitrary.
         { save current token }
         if token in [_CWCHAR,_CWSTRING,_CCHAR,_CSTRING,_INTCONST,_REALNUMBER,_ID] then
           internalerror(200511178);
-        replaysavetoken:=token;
-        old_settings:=current_settings;
+        replaystack:=treplaystack.create(token,current_settings,replaytokenbuf,replaystack);
         if assigned(inputpointer) then
           dec(inputpointer);
         { install buffer }
@@ -2117,15 +2137,16 @@ In case not, the value returned can be arbitrary.
         { End of replay buffer? Then load the next char from the file again }
         if replaytokenbuf.pos>=replaytokenbuf.size then
           begin
-            replaytokenbuf:=nil;
+            token:=replaystack.token;
+            replaytokenbuf:=replaystack.tokenbuf;
+            { restore compiler settings }
+            current_settings:=replaystack.settings;
+            popreplaystack;
             if assigned(inputpointer) then
               begin
                 c:=inputpointer^;
                 inc(inputpointer);
               end;
-            token:=replaysavetoken;
-            { restore compiler settings }
-            current_settings:=old_settings;
             exit;
           end;
         repeat
@@ -2549,6 +2570,18 @@ In case not, the value returned can be arbitrary.
       end;
 
 
+    procedure tscannerfile.popreplaystack;
+      var
+        hp : treplaystack;
+      begin
+        if assigned(replaystack) then
+         begin
+           hp:=replaystack.next;
+           replaystack.free;
+           replaystack:=hp;
+         end;
+      end;
+
     procedure tscannerfile.handleconditional(p:tdirectiveitem);
       begin
         savetokenpos;

+ 3 - 3
compiler/symdef.pas

@@ -862,8 +862,8 @@ implementation
              prefix:=s;
            st:=st.defowner.owner;
          end;
-        { object/classes symtable }
-        if (st.symtabletype=ObjectSymtable) then
+        { object/classes symtable, nested type definitions in classes require the while loop }
+        while st.symtabletype=ObjectSymtable do
          begin
            if st.defowner.typ<>objectdef then
             internalerror(200204174);
@@ -872,7 +872,7 @@ implementation
          end;
         { symtable must now be static or global }
         if not(st.symtabletype in [staticsymtable,globalsymtable]) then
-         internalerror(200204175);
+          internalerror(200204175);
         result:='';
         if typeprefix<>'' then
           result:=result+typeprefix+'_';

+ 23 - 0
tests/test/tgeneric18.pp

@@ -0,0 +1,23 @@
+program tgeneric18;
+
+{$mode objfpc}{$H+}
+
+type
+
+  { TFirstGeneric }
+
+  generic TFirstGeneric<T> = class(TObject)
+  end;
+
+  { TSecondGeneric }
+
+  generic TSecondGeneric<T> = class(TObject)
+  type public
+    TFirstGenericType = specialize TFirstGeneric<T>;
+  end;
+
+var
+  Second: specialize TSecondGeneric<string>;
+begin
+end.
+