Forráskód Böngészése

* ncgrtti.pas: RTTI generation for helpers is handled like that for classes
* pdecl.pas: prohibit generic helper declarations
* pdecobj.pas: helpers extending generic types are not allowed (theoretically one could experiment with allowing this for Delphi style generics...)
* symtable.pas:
- is_visible_for_object: helpers can access (strict) protected fields of extended types
- searchsym_in_helper: use the correct contextclass and the correct search function
- search_default_property: search for default properties in helpers first
* symsym.pas: added a global variable that allows to track whether we are parsing inside a special system function
* pexpr.pas:
- statement_syssym: track the current syssym
- factor.factor_read_id: helper types are allowed inside "sizeof", "bitsizeof" and "typeinfo"

git-svn-id: branches/svenbarth/classhelpers@17097 -

svenbarth 14 éve
szülő
commit
5218666328
6 módosított fájl, 51 hozzáadás és 14 törlés
  1. 4 4
      compiler/ncgrtti.pas
  2. 2 1
      compiler/pdecl.pas
  3. 1 1
      compiler/pdecobj.pas
  4. 8 2
      compiler/pexpr.pas
  5. 2 0
      compiler/symsym.pas
  6. 34 6
      compiler/symtable.pas

+ 4 - 4
compiler/ncgrtti.pas

@@ -850,6 +850,7 @@ implementation
 
         begin
            case def.objecttype of
+             odt_helper,
              odt_class:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
              odt_object:
@@ -870,7 +871,7 @@ implementation
            case rt of
              initrtti :
                begin
-                 if def.objecttype in [odt_class,odt_object] then
+                 if def.objecttype in [odt_class,odt_object,odt_helper] then
                    objectdef_rtti_fields(def)
                  else
                    objectdef_rtti_interface_init(def);
@@ -878,6 +879,7 @@ implementation
              fullrtti :
                begin
                  case def.objecttype of
+                   odt_helper,
                    odt_class:
                      objectdef_rtti_class_full(def);
                    odt_object:
@@ -920,9 +922,7 @@ implementation
                 recorddef_rtti(trecorddef(def));
             end;
           objectdef :
-            // TODO : check whether Delphi generates RTTI for helpers
-            if not is_objectpascal_helper(def) then
-              objectdef_rtti(tobjectdef(def));
+            objectdef_rtti(tobjectdef(def));
           else
             unknown_rtti(tstoreddef(def));
         end;

+ 2 - 1
compiler/pdecl.pas

@@ -644,7 +644,8 @@ implementation
               end;
             end;
 
-           if isgeneric and not(hdef.typ in [objectdef,recorddef,arraydef,procvardef]) then
+           if isgeneric and (not(hdef.typ in [objectdef,recorddef,arraydef,procvardef])
+               or is_objectpascal_helper(hdef)) then
              message(parser_e_cant_create_generics_of_this_type);
 
            { Stop recording a generic template }

+ 1 - 1
compiler/pdecobj.pas

@@ -592,7 +592,7 @@ implementation
           Internalerror(2011021001);
 
         consume(_FOR);
-        single_type(hdef,[stoAllowTypeDef,stoParseClassParent]);
+        single_type(hdef,[stoParseClassParent]);
         if (not assigned(hdef)) or
            not (hdef.typ in [objectdef,recorddef]) then
           begin

+ 8 - 2
compiler/pexpr.pas

@@ -261,8 +261,11 @@ implementation
         p1,p2,paras  : tnode;
         err,
         prev_in_args : boolean;
+        prev_current_syssym : byte;
       begin
         prev_in_args:=in_args;
+        prev_current_syssym:=current_syssym;
+        current_syssym:=l;
         case l of
 
           in_new_x :
@@ -822,6 +825,7 @@ implementation
 
         end;
         in_args:=prev_in_args;
+        current_syssym:=prev_current_syssym;
       end;
 
 
@@ -1535,8 +1539,10 @@ implementation
                          end
                        else
                         begin
-                          { TClassHelper.Something is not allowed }
-                          if is_objectpascal_helper(hdef) then
+                          { TClassHelper.Something is not allowed, but
+                            TypeInfo(TClassHelper) and SizeOf(TClassHelper) is }
+                          if is_objectpascal_helper(hdef) and
+                              not (current_syssym in [in_typeinfo_x,in_sizeof_x,in_bitsizeof_x]) then
                             begin
                               Message(parser_e_no_category_as_types);
                               { for recovery we use the extended class }

+ 2 - 0
compiler/symsym.pas

@@ -323,6 +323,8 @@ interface
 
     var
        generrorsym : tsym;
+       current_syssym : byte = 0; { used for parsing expressions that need
+                                    special handling in the system functions }
 
 implementation
 

+ 34 - 6
compiler/symtable.pas

@@ -1819,9 +1819,16 @@ implementation
             end;
           vis_strictprotected :
             begin
-               result:=assigned(current_structdef) and
-                       (current_structdef.is_related(symownerdef) or
-                        is_owned_by(current_structdef,symownerdef));
+               result:=(
+                         assigned(current_structdef) and
+                         (current_structdef.is_related(symownerdef) or
+                         is_owned_by(current_structdef,symownerdef))
+                       ) or
+                       (
+                         { helpers can access strict protected symbols }
+                         is_objectpascal_helper(contextobjdef) and
+                         tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                       );
             end;
           vis_protected :
             begin
@@ -1851,7 +1858,12 @@ implementation
                         (
                           not assigned(current_structdef) and
                           (symownerdef.owner.iscurrentunit)
-                         )
+                        ) or
+                        (
+                          { helpers can access protected symbols }
+                          is_objectpascal_helper(contextobjdef) and
+                          tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                        )
                        )
                       );
             end;
@@ -2361,7 +2373,7 @@ implementation
                   end;
               end;
             { search in the hierarchy of the extended class }
-            found:=searchsym_in_class(tobjectdef(classh.extendeddef),tobjectdef(classh.extendeddef),s,tmpsrsym,tmpsrsymtable,hs_nosearch);
+            found:=searchsym_in_class(tobjectdef(classh.extendeddef),contextclassh,s,tmpsrsym,tmpsrsymtable,hs_nosearch);
             if not found then
               begin
                 if assigned(classh.childof) then
@@ -2389,7 +2401,7 @@ implementation
                     result:=false;
                     { search in the helper's parents first }
                     if assigned(classh.childof) then
-                      result:=searchsym_in_class(classh.childof,contextclassh,s,srsym,srsymtable,hs_nosearch);
+                      result:=searchsym_in_helper(classh.childof,contextclassh,s,srsym,srsymtable,false);
                     if not result then
                       begin
                         { we use the symbol found in one of the extended
@@ -2848,8 +2860,24 @@ implementation
    { returns the default property of a class, searches also anchestors }
      var
        _defaultprop : tpropertysym;
+       helperpd : tobjectdef;
      begin
         _defaultprop:=nil;
+        { first search in helper's hierarchy }
+        if search_last_objectpascal_helper(pd, helperpd) then
+          while assigned(helperpd) do
+            begin
+              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
+              if assigned(_defaultprop) then
+                break;
+              helperpd:=helperpd.childof;
+            end;
+        if assigned(_defaultprop) then
+          begin
+            search_default_property:=_defaultprop;
+            exit;
+          end;
+        { now search in the type's hierarchy itself }
         while assigned(pd) do
           begin
              pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);