compiler: allow compiler to find real class definition during class members parse to handle references to self constants + test

git-svn-id: trunk@21290 -

.gitattributes

@@ -10454,6 +10454,7 @@ tests/test/tclass13.pp svneol=native#text/pascal
 tests/test/tclass13a.pp svneol=native#text/plain
 tests/test/tclass13b.pp svneol=native#text/plain
 tests/test/tclass13c.pp svneol=native#text/pascal
+tests/test/tclass13d.pp svneol=native#text/pascal
 tests/test/tclass14a.pp svneol=native#text/pascal
 tests/test/tclass14b.pp svneol=native#text/pascal
 tests/test/tclass15.pp svneol=native#text/pascal

compiler/pdecl.pas

@@ -492,7 +492,7 @@ implementation
                     end;
                     consume(token);
                     { we can ignore the result, the definition is modified }
-                    object_dec(objecttype,genorgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
+                    object_dec(objecttype,genorgtypename,newtype,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
                     newtype:=ttypesym(sym);
                     hdef:=newtype.typedef;
                   end
@@ -595,7 +595,7 @@ implementation
               current_tokenpos:=defpos;
               current_tokenpos:=storetokenpos;
               { read the type definition }
-              read_named_type(hdef,genorgtypename,gendef,generictypelist,false);
+              read_named_type(hdef,newtype,gendef,generictypelist,false);
               { update the definition of the type }
               if assigned(hdef) then
                 begin

compiler/pdecobj.pas

@@ -30,7 +30,7 @@ interface
       globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
 
     { parses a (class) method declaration }
     function method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@@ -1225,7 +1225,7 @@ implementation
       end;
 
 
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
       var
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
@@ -1236,6 +1236,7 @@ implementation
         list: TFPObjectList;
         s: String;
         st: TSymtable;
+        olddef: tdef;
       begin
         old_current_structdef:=current_structdef;
         old_current_genericdef:=current_genericdef;
@@ -1422,9 +1423,24 @@ implementation
             { parse optional GUID for interfaces }
             parse_guid;
 
+            { classes can handle links to themself not only inside type blocks
+              but in const blocks too. to make this possible we need to set
+              their symbols to real defs instead of errordef }
+
+            if assigned(objsym) and (objecttype in [odt_class,odt_javaclass]) then
+              begin
+                olddef:=ttypesym(objsym).typedef;
+                ttypesym(objsym).typedef:=current_structdef;
+              end
+            else
+              olddef:=nil;
+
             { parse and insert object members }
             parse_object_members;
 
+            if assigned(olddef) then
+              ttypesym(objsym).typedef:=olddef;
+
           if not(oo_is_external in current_structdef.objectoptions) then
             begin
               { In Java, constructors are not automatically inherited (so you can

compiler/pexpr.pas

@@ -2132,13 +2132,11 @@ implementation
                  searchsym_type(pattern,srsym,srsymtable)
                else
                  searchsym(pattern,srsym,srsymtable);
-
                { handle unit specification like System.Writeln }
                unit_found:=try_consume_unitsym(srsym,srsymtable,t,true);
                storedpattern:=pattern;
                orgstoredpattern:=orgpattern;
                consume(t);
-
                { named parameter support }
                found_arg_name:=false;
 

compiler/pgenutil.pas

@@ -437,7 +437,7 @@ uses
                 current_tokenpos:=current_filepos;
                 current_scanner.startreplaytokens(genericdef.generictokenbuf,
                   genericdef.change_endian);
-                read_named_type(tt,finalspecializename,genericdef,generictypelist,false);
+                read_named_type(tt,srsym,genericdef,generictypelist,false);
                 current_filepos:=oldcurrent_filepos;
                 ttypesym(srsym).typedef:=tt;
                 tt.typesym:=srsym;

compiler/ptype.pas

@@ -44,7 +44,7 @@ interface
     procedure single_type(var def:tdef;options:TSingleTypeOptions);
 
     { reads any type declaration, where the resulting type will get name as type identifier }
-    procedure read_named_type(var def:tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
 
     { reads any type declaration }
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
@@ -777,7 +777,7 @@ implementation
 
 
     { reads a type definition and returns a pointer to it }
-    procedure read_named_type(var def : tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
       var
         pt : tnode;
         tt2 : tdef;
@@ -786,6 +786,7 @@ implementation
         l,v : TConstExprInt;
         oldpackrecords : longint;
         defpos,storepos : tfileposinfo;
+        name: TIDString;
 
         procedure expr_type;
         var
@@ -1278,6 +1279,10 @@ implementation
         st: tsymtable;
       begin
          def:=nil;
+         if assigned(newsym) then
+           name:=newsym.RealName
+         else
+           name:='';
          case token of
             _STRING,_FILE:
               begin
@@ -1405,7 +1410,7 @@ implementation
                 if (idtoken=_HELPER) and (m_advanced_records in current_settings.modeswitches) then
                   begin
                     consume(_HELPER);
-                    def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_record);
+                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_record);
                   end
                 else
                   def:=record_dec(name,genericdef,genericlist);
@@ -1435,12 +1440,12 @@ implementation
                       _CLASS :
                         begin
                           consume(_CLASS);
-                          def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
+                          def:=object_dec(odt_class,name,newsym,genericdef,genericlist,nil,ht_none);
                         end;
                       _OBJECT :
                         begin
                           consume(_OBJECT);
-                          def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
+                          def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
                         end;
                       else begin
                         consume(_RECORD);
@@ -1457,7 +1462,7 @@ implementation
                 if not(m_class in current_settings.modeswitches) then
                   Message(parser_f_need_objfpc_or_delphi_mode);
                 consume(token);
-                def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_dispinterface,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
             _CLASS :
               begin
@@ -1488,15 +1493,15 @@ implementation
                 if (idtoken=_HELPER) then
                   begin
                     consume(_HELPER);
-                    def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class);
+                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_class);
                   end
                 else
-                  def:=object_dec(default_class_type,name,genericdef,genericlist,nil,ht_none);
+                  def:=object_dec(default_class_type,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
             _CPPCLASS :
               begin
                 consume(token);
-                def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_cppclass,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
             _OBJCCLASS :
               begin
@@ -1504,7 +1509,7 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_objcclass,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
             _INTERFACE :
               begin
@@ -1515,11 +1520,11 @@ implementation
                 consume(token);
                 case current_settings.interfacetype of
                   it_interfacecom:
-                    def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil,ht_none);
+                    def:=object_dec(odt_interfacecom,name,newsym,genericdef,genericlist,nil,ht_none);
                   it_interfacecorba:
-                    def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil,ht_none);
+                    def:=object_dec(odt_interfacecorba,name,newsym,genericdef,genericlist,nil,ht_none);
                   it_interfacejava:
-                    def:=object_dec(odt_interfacejava,name,genericdef,genericlist,nil,ht_none);
+                    def:=object_dec(odt_interfacejava,name,newsym,genericdef,genericlist,nil,ht_none);
                   else
                     internalerror(2010122612);
                 end;
@@ -1530,7 +1535,7 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_objcprotocol,name,newsym,genericdef,genericlist,nil,ht_none);
                end;
             _OBJCCATEGORY :
                begin
@@ -1538,12 +1543,12 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_objccategory,name,newsym,genericdef,genericlist,nil,ht_none);
                end;
             _OBJECT :
               begin
                 consume(token);
-                def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
+                def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
             _PROCEDURE,
             _FUNCTION:
@@ -1573,7 +1578,7 @@ implementation
 
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
       begin
-        read_named_type(def,'',nil,nil,parseprocvardir);
+        read_named_type(def,nil,nil,nil,parseprocvardir);
       end;
 
 

tests/test/tclass13d.pp

@@ -0,0 +1,13 @@
+{ %norun }
+{$mode delphi}
+
+type
+  TObj = class
+  const
+    Val = 1;
+    V1: Integer = Val;
+    V2: Integer = TObj.Val;
+  end;
+
+begin
+end.