--- Merging r14176 into '.':

A    tests/test/tgeneric18.pp
U    compiler/symdef.pas
U    compiler/defcmp.pas
U    compiler/scanner.pas
U    compiler/ptype.pas
--- Merging r14243 into '.':
U    compiler/symtable.pas

# revisions: 14176,14243
------------------------------------------------------------------------
r14176 | florian | 2009-11-14 23:24:55 +0100 (Sat, 14 Nov 2009) | 2 lines
Changed paths:
   M /trunk/compiler/defcmp.pas
   M /trunk/compiler/ptype.pas
   M /trunk/compiler/scanner.pas
   M /trunk/compiler/symdef.pas
   A /trunk/tests/test/tgeneric18.pp

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

------------------------------------------------------------------------
------------------------------------------------------------------------
r14243 | paul | 2009-11-21 18:57:32 +0100 (Sat, 21 Nov 2009) | 1 line
Changed paths:
   M /trunk/compiler/symtable.pas

compiler: fix is_visible_for_object for nested specialization
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16242 -

.gitattributes

@@ -8350,6 +8350,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

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;
 

compiler/ptype.pas

@@ -140,7 +140,6 @@ implementation
       end;
 
 
-
     procedure generate_specialization(var tt:tdef);
       var
         st  : TSymtable;
@@ -174,10 +173,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;
 
@@ -316,6 +318,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

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;
@@ -1788,6 +1796,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
@@ -1823,6 +1841,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;
@@ -1858,6 +1877,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;
@@ -2064,8 +2085,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 }
@@ -2087,15 +2107,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
@@ -2519,6 +2540,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;

compiler/symdef.pas

@@ -839,8 +839,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);
@@ -849,7 +849,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+'_';

compiler/symtable.pas

@@ -1560,8 +1560,18 @@ implementation
             begin
               { private symbols are allowed when we are in the same
                 module as they are defined }
-              result:=(symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                      (symownerdef.owner.iscurrentunit);
+              result:=(
+                       (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                       (symownerdef.owner.iscurrentunit)
+                      ) or
+                      ( // the case of specialize inside the generic declaration
+                       (symownerdef.owner.symtabletype = objectsymtable) and
+                       assigned(current_objectdef) and
+                       (
+                         (current_objectdef=symownerdef) or
+                         (current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
+                       )
+                      );
             end;
           vis_strictprivate :
             begin
@@ -1588,6 +1598,14 @@ implementation
                         (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
                         (contextobjdef.owner.iscurrentunit) and
                         contextobjdef.is_related(symownerdef)
+                       ) or
+                       ( // the case of specialize inside the generic declaration
+                        (symownerdef.owner.symtabletype = objectsymtable) and
+                        assigned(current_objectdef) and
+                        (
+                         (current_objectdef=symownerdef) or
+                         (current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
+                        )
                        )
                       );
             end;

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