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

+ 26 - 7
compiler/ncal.pas

@@ -3947,6 +3947,7 @@ implementation
 
 
       var
       var
         candidates : tcallcandidates;
         candidates : tcallcandidates;
+        ccflags : tcallcandidatesflags;
         oldcallnode : tcallnode;
         oldcallnode : tcallnode;
         hpt,tmp : tnode;
         hpt,tmp : tnode;
         pt : tcallparanode;
         pt : tcallparanode;
@@ -3955,7 +3956,6 @@ implementation
         cand_cnt : integer;
         cand_cnt : integer;
         i : longint;
         i : longint;
         ignoregenericparacall,
         ignoregenericparacall,
-        ignorevisibility,
         is_const : boolean;
         is_const : boolean;
         statements : tstatementnode;
         statements : tstatementnode;
         converted_result_data : ttempcreatenode;
         converted_result_data : ttempcreatenode;
@@ -4078,13 +4078,32 @@ implementation
                            exit;
                            exit;
                          end;
                          end;
                      end;
                      end;
+
+                   ccflags:=[];
+
                    { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
                    { 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
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are
                      with the parameter size or the procedures are