Bladeren bron

* nflw.pas: search for enumerators in helpers for records as well
* pdecobj.pas:
- parse_object_members: in record helpers class methods need to be declared as "static" like in records
- object_dec:
- allow "published" in helpers as well
- disallow inheritance for record helpers in mode Delphi (and remove the forward declaration flag in that case)
* pdecsub.pas:
pd_abstract: "abstract" isn't allowed in either mode
* pexpr.pas: multiple corrections because of "inherited" and records
- allow "inherited" for "record helpers" (except for mode Delphi)
- load the symbol from the correct class (I hope...)
- give a more precise error message if "inherited" is used in records
* ptype.pas: I forgot to adjust the "(bit)packed record" case
* symtable.pas:
- searchsym_in_helper: "result" was not initialized (and identation fix)
- search_last_objectpascal_helper:
- don't search if there are no helpers (useful for projects that does not contain helpers like the compiler itself)
- don't search if the type to search helpers for is defined locally
- don't search if the type is a anonymous record
- search_struct_member: search for symbols in helpers as well
- msg*:
* correct the message for "parser_e_not_allowed_in_helper"
* add message "parser_e_inherited_not_in_record" which is used to tell that the use of "inherited" is not allowed in records and (in mode Delphi) record helpers

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

svenbarth 14 jaren geleden
bovenliggende
commit
a944be69a6
9 gewijzigde bestanden met toevoegingen van 432 en 375 verwijderingen
  1. 8 4
      compiler/msg/errore.msg
  2. 3 2
      compiler/msgidx.inc
  3. 341 340
      compiler/msgtxt.inc
  4. 2 4
      compiler/nflw.pas
  5. 16 2
      compiler/pdecobj.pas
  6. 1 2
      compiler/pdecsub.pas
  7. 34 14
      compiler/pexpr.pas
  8. 3 1
      compiler/ptype.pas
  9. 24 6
      compiler/symtable.pas

+ 8 - 4
compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03306 is the last used one
+# 03307 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1368,12 +1368,16 @@ parser_e_at_least_one_argument_must_be_of_type=03303_E_Either the result or at l
 parser_e_cant_use_type_parameters_here=03304_E_Type parameters may require initialization/finalization - can't be used in variant records
 % Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization
 % code which is implicitly generated by the compiler.
-parser_e_not_allowed_in_helper=03305_E_"$1" is not allowed in helpers
+parser_e_not_allowed_in_helper=03305_E_"$1" is not allowed in helper types
 % Some directives and specifiers like "virtual", "dynamic", "override" aren't
-% allowed inside class helpers in mode ObjFPC (they are ignored in mode Delphi),
-% because they have no meaning within helpers.
+% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi),
+% because they have no meaning within helpers. Also "abstract" isn't allowed in
+% either mode.
 parser_e_no_class_constructor_in_helpers=03306_E_Class constructors aren't allowed in helpers
 % Class constructor declarations aren't allowed in helpers.
+parser_e_inherited_not_in_record=03307_E_The use of "inherited" is not allowed in a record
+% As records don't suppport inheritance the use of "inherited" is prohibited for
+% these as well as for record helpers (in mode "Delphi" only).
 % \end{description}
 # Type Checking
 #

+ 3 - 2
compiler/msgidx.inc

@@ -395,6 +395,7 @@ const
   parser_e_cant_use_type_parameters_here=03304;
   parser_e_not_allowed_in_helper=03305;
   parser_e_no_class_constructor_in_helpers=03306;
+  parser_e_inherited_not_in_record=03307;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -888,9 +889,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 59014;
+  MsgTxtSize = 59095;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,307,103,84,54,111,22,202,63,
+    24,88,308,103,84,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

File diff suppressed because it is too large
+ 341 - 340
compiler/msgtxt.inc


+ 2 - 4
compiler/nflw.pas

@@ -863,10 +863,8 @@ implementation
                 // if there is no operator then search for class/object enumerator method
                 if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
                   begin
-                    { first search using the class helper hierarchy if it's a
-                      class }
-                    if (expr.resultdef.typ=objectdef) and
-                        search_last_objectpascal_helper(tobjectdef(expr.resultdef),nil,helperdef) then
+                    { first search using the helper hierarchy }
+                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
                       repeat
                         pd:=helperdef.search_enumerator_get;
                         helperdef:=helperdef.childof;

+ 16 - 2
compiler/pdecobj.pas

@@ -915,6 +915,12 @@ implementation
                     if (m_mac in current_settings.modeswitches) then
                       include(pd.procoptions,po_virtualmethod);
 
+                    { for record helpers only static class methods are allowed }
+                    if is_objectpascal_helper(current_structdef) and
+                        is_record(current_objectdef.extendeddef) and
+                        is_classdef and not (po_staticmethod in pd.procoptions) then
+                      MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
+
                     handle_calling_convention(pd);
 
                     { add definition to procsym }
@@ -1139,7 +1145,7 @@ implementation
         { set published flag in $M+ mode, it can also be inherited and will
           be added when the parent class set with tobjectdef.set_parent (PFV) }
         if (cs_generate_rtti in current_settings.localswitches) and
-           (current_objectdef.objecttype in [odt_interfacecom,odt_class]) then
+           (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
           include(current_structdef.objectoptions,oo_can_have_published);
 
         { Objective-C objectdefs can be "formal definitions", in which case
@@ -1179,7 +1185,15 @@ implementation
             parse_generic:=(df_generic in current_structdef.defoptions);
 
             { parse list of parent classes }
-            parse_parent_classes;
+            { for record helpers in mode Delphi this is not allowed }
+            if not (is_objectpascal_helper(current_objectdef) and
+                (m_delphi in current_settings.modeswitches) and
+                (helpertype=ht_record)) then
+              parse_parent_classes
+            else
+              { remove forward flag, is resolved (this is normally done inside
+                parse_parent_classes) }
+              exclude(current_structdef.objectoptions,oo_is_forward);
 
             { parse extended type for helpers }
             if is_objectpascal_helper(current_structdef) then

+ 1 - 2
compiler/pdecsub.pas

@@ -1628,8 +1628,7 @@ procedure pd_abstract(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200304269);
-  if is_objectpascal_helper(tprocdef(pd).struct) and
-      (m_objfpc in current_settings.modeswitches) then
+  if is_objectpascal_helper(tprocdef(pd).struct) then
     Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_ABSTRACT].str);
   if assigned(tprocdef(pd).struct) and
     (oo_is_sealed in tprocdef(pd).struct.objectoptions) then

+ 34 - 14
compiler/pexpr.pas

@@ -2361,16 +2361,13 @@ implementation
                     assigned(current_structdef) and
                     (current_structdef.typ=objectdef) then
                   begin
-                    { In Object Pascal helpers "inherited" always calls a
-                      method of the extended class }
-                    if is_objectpascal_helper(current_structdef) then
-                      begin
-                        if not is_class(tobjectdef(current_structdef).extendeddef) then
-                          Internalerror(2011021701);
-                        hclassdef:=tobjectdef(tobjectdef(current_structdef).extendeddef);
-                      end
-                    else
-                      hclassdef:=tobjectdef(current_structdef).childof;
+                    { for record helpers in mode Delphi "inherited" is not
+                      allowed }
+                    if is_objectpascal_helper(current_structdef) and
+                        (m_delphi in current_settings.modeswitches) and
+                        is_record(tobjectdef(current_structdef).extendeddef) then
+                      Message(parser_e_inherited_not_in_record);
+                    hclassdef:=tobjectdef(current_structdef).childof;
                     { Objective-C categories *replace* methods in the class
                       they extend, or add methods to it. So calling an
                       inherited method always calls the method inherited from
@@ -2420,7 +2417,25 @@ implementation
                        case srsym.typ of
                          procsym:
                            begin
-                             hdef:=hclassdef;
+                             if is_objectpascal_helper(current_structdef) then
+                               begin
+                                 { for a helper load the procdef either from the
+                                   extended type, from the parent helper or from
+                                   the extended type of the parent helper
+                                   depending on the def the found symbol belongs
+                                   to }
+                                 if (srsym.Owner.defowner.typ=objectdef) and
+                                     is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
+                                   if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
+                                       assigned(tobjectdef(current_structdef).childof) then
+                                     hdef:=tobjectdef(current_structdef).childof
+                                   else
+                                     hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
+                                 else
+                                   hdef:=tdef(srsym.Owner.defowner);
+                               end
+                             else
+                               hdef:=hclassdef;
                              if (po_classmethod in current_procinfo.procdef.procoptions) or
                                 (po_staticmethod in current_procinfo.procdef.procoptions) then
                                hdef:=tclassrefdef.create(hdef);
@@ -2469,9 +2484,14 @@ implementation
                   end
                  else
                    begin
-                      Message(parser_e_generic_methods_only_in_methods);
-                      again:=false;
-                      p1:=cerrornode.create;
+                     { in case of records we use a more clear error message }
+                     if assigned(current_structdef) and
+                         (current_structdef.typ=recorddef) then
+                       Message(parser_e_inherited_not_in_record)
+                     else
+                       Message(parser_e_generic_methods_only_in_methods);
+                     again:=false;
+                     p1:=cerrornode.create;
                    end;
                  postfixoperators(p1,again);
                end;

+ 3 - 1
compiler/ptype.pas

@@ -1524,8 +1524,10 @@ implementation
                           consume(_OBJECT);
                           def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
                         end;
-                      else
+                      else begin
+                        consume(_RECORD);
                         def:=record_dec(name,genericdef,genericlist);
+                      end;
                     end;
                     current_settings.packrecords:=oldpackrecords;
                   end;

+ 24 - 6
compiler/symtable.pas

@@ -2348,6 +2348,7 @@ implementation
         hashedid      : THashedIDString;
         parentclassh  : tobjectdef;
       begin
+        result:=false;
         if not is_objectpascal_helper(classh) then
           Internalerror(2011030101);
         hashedid.id:=s;
@@ -2395,10 +2396,10 @@ implementation
               end;
             parentclassh:=parentclassh.childof;
           end;
-          if is_class(classh.extendeddef) then
-            { now search in the parents of the extended class (with helpers!) }
-            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,true);
-            { addsymref is already called by searchsym_in_class }
+        if is_class(classh.extendeddef) then
+          { now search in the parents of the extended class (with helpers!) }
+          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,true);
+          { addsymref is already called by searchsym_in_class }
       end;
 
     function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef;
@@ -2543,10 +2544,11 @@ implementation
         s: string;
         list: TFPObjectList;
         i: integer;
+        st: tsymtable;
 {$endif}
       begin
-{$ifdef useoldsearch}
         result:=false;
+{$ifdef useoldsearch}
         stackitem:=symtablestack.stack;
         while assigned(stackitem) do
           begin
@@ -2574,7 +2576,21 @@ implementation
             stackitem:=stackitem^.next;
           end;
 {$else}
-        result:=false;
+        { when there are no helpers active currently then we don't need to do
+          anything }
+        if current_module.extendeddefs.count=0 then
+          exit;
+        { no helpers for anonymous types }
+        if not assigned(pd.objrealname) or (pd.objrealname^='') then
+          exit;
+        { if pd is defined inside a procedure we must not use make_mangledname
+          (as a helper may not be defined in a procedure this is no problem...)}
+        st:=pd.owner;
+        while st.symtabletype in [objectsymtable,recordsymtable] do
+          st:=st.defowner.owner;
+        if st.symtabletype=localsymtable then
+          exit;
+        { the mangled name is used as the key for tmodule.extendeddefs }
         s:=make_mangledname('',pd.symtable,'');
         list:=TFPObjectList(current_module.extendeddefs.Find(s));
         if assigned(list) and (list.count>0) then
@@ -2775,6 +2791,8 @@ implementation
         { in case this is a formal objcclass, first find the real definition }
         if (oo_is_formal in pd.objectoptions) then
           pd:=find_real_objcclass_definition(tobjectdef(pd),true);
+        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
+          exit;
         hashedid.id:=s;
         orgpd:=pd;
         while assigned(pd) do

Some files were not shown because too many files changed in this diff