Browse Source

Use a set instead of boolean arguments to TCallCandidates.

Rika Ichinose 3 years ago
parent
commit
510a281c3f
2 changed files with 63 additions and 38 deletions
  1. 37 31
      compiler/htypechk.pas
  2. 26 7
      compiler/ncal.pas

+ 37 - 31
compiler/htypechk.pas

@@ -69,6 +69,12 @@ interface
          wrongparanr : byte;
       end;
 
+      tcallcandidatesflag =
+      (
+        cc_ignorevisibility,cc_allowdefaultparas,cc_objcidcall,cc_explicitunit,cc_searchhelpers,cc_anoninherited
+      );
+      tcallcandidatesflags = set of tcallcandidatesflag;
+
       tcallcandidates = object
       private
         FProcsym     : tprocsym;
@@ -81,13 +87,13 @@ interface
         FParaLength : smallint;
         FAllowVariant : boolean;
         FParaAnonSyms : tfplist;
-        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
-        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean;spezcontext:tspecializationcontext);
-        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
-        procedure calc_distance(st_root:tsymtable;objcidcall: boolean);
-        function  proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
+        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
+        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
+        procedure create_candidate_list(flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
+        procedure calc_distance(st_root:tsymtable;flags:tcallcandidatesflags);
+        function  proc_add(st:tsymtable;pd:tprocdef):pcandidate;
       public
-        constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+        constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
         constructor init_operator(op:ttoken;ppn:tnode);
         destructor done;
         procedure list(all:boolean);
@@ -2194,7 +2200,7 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+    constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -2202,7 +2208,7 @@ implementation
         FProcsym:=sym;
         FProcsymtable:=st;
         FParanode:=ppn;
-        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext);
+        create_candidate_list(flags,spezcontext);
       end;
 
 
@@ -2212,7 +2218,7 @@ implementation
         FProcsym:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
-        create_candidate_list(false,false,false,false,false,false,nil);
+        create_candidate_list([],nil);
       end;
 
 
@@ -2253,7 +2259,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
 
       var
         changedhierarchy : boolean;
@@ -2285,7 +2291,7 @@ implementation
                 anything compatible to the parameters -- except in case of
                 the presence of a messagestr/int, in which case those have to
                 match exactly }
-              if anoninherited then
+              if cc_anoninherited in flags then
                 if po_msgint in current_procinfo.procdef.procoptions then
                   begin
                     if not(po_msgint in pd.procoptions) or
@@ -2366,7 +2372,7 @@ implementation
                    (tobjectdef(structdef).objecttype in objecttypes_with_helpers)
                  )
                )
-               and searchhelpers then
+               and (cc_searchhelpers in flags) then
              begin
                if m_multi_helpers in current_settings.modeswitches then
                  begin
@@ -2441,7 +2447,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean;spezcontext:tspecializationcontext);
+    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
       var
         j          : integer;
         pd         : tprocdef;
@@ -2457,7 +2463,7 @@ implementation
           the list can change in every situation }
         if FOperator=NOTOKEN then
           begin
-            if not objcidcall then
+            if not (cc_objcidcall in flags) then
               hashedid.id:=FProcsym.name
             else
               hashedid.id:=class_helper_prefix+FProcsym.name;
@@ -2479,7 +2485,7 @@ implementation
               specified explicitly, stop searching after its symtable(s) have
               been checked (can be both the static and the global symtable
               in case it's the current unit itself) }
-            if explicitunit and
+            if (cc_explicitunit in flags) and
                (FProcsymtable.symtabletype in [globalsymtable,staticsymtable]) and
                (srsymtable.moduleid<>FProcsymtable.moduleid) then
               break;
@@ -2525,7 +2531,7 @@ implementation
                       except for Objective-C methods called via id }
                     if foundanything and
                        not hasoverload and
-                       not objcidcall then
+                       not (cc_objcidcall in flags) then
                       break;
                   end;
               end;
@@ -2534,7 +2540,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+    procedure tcallcandidates.create_candidate_list(flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
       var
         j     : integer;
         pd    : tprocdef;
@@ -2551,10 +2557,10 @@ implementation
 
         { Find all available overloads for this procsym }
         ProcdefOverloadList:=TFPObjectList.Create(false);
-        if not objcidcall and
+        if not (cc_objcidcall in flags) and
            (FOperator=NOTOKEN) and
            (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
-          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext)
+          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,flags,spezcontext)
         else
         if (FOperator<>NOTOKEN) then
           begin
@@ -2565,13 +2571,13 @@ implementation
               begin
                 if (pt.resultdef.typ=recorddef) and
                     (sto_has_operator in tabstractrecorddef(pt.resultdef).symtable.tableoptions) then
-                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext);
+                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,flags,spezcontext);
                 pt:=tcallparanode(pt.right);
               end;
-            collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit,spezcontext);
+            collect_overloads_in_units(ProcdefOverloadList,flags,spezcontext);
           end
         else
-          collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit,spezcontext);
+          collect_overloads_in_units(ProcdefOverloadList,flags,spezcontext);
 
         { determine length of parameter list.
           for operators also enable the variant-operators if
@@ -2623,19 +2629,19 @@ implementation
 {$endif}
                (
                 (
-                 allowdefaultparas and
+                 (cc_allowdefaultparas in flags) and
                  (
                   (FParalength<=pd.maxparacount) or
                   (po_varargs in pd.procoptions)
                  )
                 ) or
                 (
-                 not allowdefaultparas and
+                 not (cc_allowdefaultparas in flags) and
                  (FParalength=pd.maxparacount)
                 )
                ) and
                (
-                ignorevisibility or
+                (cc_ignorevisibility in flags) or
                 (
                   pd.is_specialization and not assigned(pd.owner) and
                   (
@@ -2675,7 +2681,7 @@ implementation
 {$endif}
                 if not found then
                   begin
-                    proc_add(st,pd,objcidcall);
+                    proc_add(st,pd);
                     added:=true;
 {$ifndef DISABLE_FAST_OVERLOAD_PATCH}
                     pd.seenmarker:=pointer(@self);
@@ -2702,13 +2708,13 @@ implementation
         end;
 {$endif}
 
-        calc_distance(st,objcidcall);
+        calc_distance(st,flags);
 
         ProcdefOverloadList.Free;
       end;
 
 
-    procedure tcallcandidates.calc_distance(st_root: tsymtable; objcidcall: boolean);
+    procedure tcallcandidates.calc_distance(st_root: tsymtable; flags:tcallcandidatesflags);
       var
         pd:tprocdef;
         candidate:pcandidate;
@@ -2717,7 +2723,7 @@ implementation
         { Give a small penalty for overloaded methods not defined in the
           current class/unit }
         st:=nil;
-        if objcidcall or
+        if (cc_objcidcall in flags) or
            not assigned(st_root) or
            not assigned(st_root.defowner) or
            (st_root.defowner.typ<>objectdef) then
@@ -2774,7 +2780,7 @@ implementation
            want to give the methods of that particular objcclass precedence
            over other methods, so instead check against the symtable in
            which this objcclass is defined }
-        if objcidcall then
+        if cc_objcidcall in flags then
           st:=st.defowner.owner;
         while assigned(candidate) do
           begin
@@ -2788,7 +2794,7 @@ implementation
       end;
 
 
-    function tcallcandidates.proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
+    function tcallcandidates.proc_add(st:tsymtable;pd:tprocdef):pcandidate;
       var
         defaultparacnt : integer;
       begin

+ 26 - 7
compiler/ncal.pas

@@ -3947,6 +3947,7 @@ implementation
 
       var
         candidates : tcallcandidates;
+        ccflags : tcallcandidatesflags;
         oldcallnode : tcallnode;
         hpt,tmp : tnode;
         pt : tcallparanode;
@@ -3955,7 +3956,6 @@ implementation
         cand_cnt : integer;
         i : longint;
         ignoregenericparacall,
-        ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
         converted_result_data : ttempcreatenode;
@@ -4078,13 +4078,32 @@ implementation
                            exit;
                          end;
                      end;
+
+                   ccflags:=[];
+
                    { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
-                   ignorevisibility:=(nf_isproperty in flags) or
-                                     ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
-                                     (cnf_ignore_visibility in callnodeflags);
-                   candidates.init(symtableprocentry,symtableproc,left,ignorevisibility,
-                     not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
-                     callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
+                   if (nf_isproperty in flags) or
+                     ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
+                     (cnf_ignore_visibility in callnodeflags)
+                   then
+                     ccflags:=ccflags+[cc_ignorevisibility];
+
+                   if not(nf_isproperty in flags) then
+                     ccflags:=ccflags+[cc_allowdefaultparas];
+
+                   if cnf_objc_id_call in callnodeflags then
+                     ccflags:=ccflags+[cc_objcidcall];
+
+                   if cnf_unit_specified in callnodeflags then
+                     ccflags:=ccflags+[cc_explicitunit];
+
+                   if callnodeflags*[cnf_anon_inherited,cnf_inherited]=[] then
+                     ccflags:=ccflags+[cc_searchhelpers];
+
+                   if cnf_anon_inherited in callnodeflags then
+                     ccflags:=ccflags+[cc_anoninherited];
+
+                   candidates.init(symtableprocentry,symtableproc,left,ccflags,spezcontext);
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are