Jelajahi Sumber

* don't search for overloads in parents for constructors

peter 22 tahun lalu
induk
melakukan
19727a3609
7 mengubah file dengan 62 tambahan dan 49 penghapusan
  1. 13 8
      compiler/defcmp.pas
  2. 6 9
      compiler/ncal.pas
  3. 10 7
      compiler/nobj.pas
  4. 6 3
      compiler/pdecobj.pas
  5. 6 3
      compiler/pdecsub.pas
  6. 15 16
      compiler/symsym.pas
  7. 6 3
      compiler/symtable.pas

+ 13 - 8
compiler/defcmp.pas

@@ -35,7 +35,9 @@ interface
 
      type
        { if acp is cp_all the var const or nothing are considered equal }
-       compare_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
+       tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
+       tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert);
+       tcompare_paras_options = set of tcompare_paras_option;
 
        tconverttype = (
           tc_equal,
@@ -103,7 +105,7 @@ interface
       search for a routine with default parameters, before
       searching for the same definition with no parameters)
     }
-    function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults,ignorehidden:boolean):tequaltype;
+    function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
 
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
@@ -1065,7 +1067,7 @@ implementation
       end;
 
 
-    function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults,ignorehidden:boolean):tequaltype;
+    function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
       var
         currpara1,
         currpara2 : TParaItem;
@@ -1079,7 +1081,7 @@ implementation
          lowesteq:=high(tequaltype);
          currpara1:=TParaItem(paralist1.first);
          currpara2:=TParaItem(paralist2.first);
-         if ignorehidden then
+         if cpo_ignorehidden in cpoptions then
            begin
              while assigned(currpara1) and currpara1.is_hidden do
                currpara1:=tparaitem(currpara1.next);
@@ -1165,7 +1167,7 @@ implementation
                end;
               currpara1:=TParaItem(currpara1.next);
               currpara2:=TParaItem(currpara2.next);
-              if ignorehidden then
+              if cpo_ignorehidden in cpoptions then
                 begin
                   while assigned(currpara1) and currpara1.is_hidden do
                     currpara1:=tparaitem(currpara1.next);
@@ -1177,7 +1179,7 @@ implementation
            when one list is empty and the other has a parameter with default
            value assigned then the parameters are also equal }
          if ((currpara1=nil) and (currpara2=nil)) or
-            (allowdefaults and
+            ((cpo_allowdefaults in cpoptions) and
              ((assigned(currpara1) and assigned(currpara1.defaultvalue)) or
               (assigned(currpara2) and assigned(currpara2.defaultvalue)))) then
            compare_paras:=lowesteq;
@@ -1211,7 +1213,7 @@ implementation
             { return equal type based on the parameters, but a proc->procvar
               is never exact, so map an exact match of the parameters to
               te_equal }
-            eq:=compare_paras(def1.para,def2.para,cp_procvar,false,false);
+            eq:=compare_paras(def1.para,def2.para,cp_procvar,[]);
             if eq=te_exact then
              eq:=te_equal;
             proc_to_procvar_equal:=eq;
@@ -1221,7 +1223,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2003-10-26 14:11:35  florian
+  Revision 1.35  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.34  2003/10/26 14:11:35  florian
     * fixed web bug 2129: explicit float casts in Delphi mode must be handled by the default code
 
   Revision 1.33  2003/10/14 12:23:06  florian

+ 6 - 9
compiler/ncal.pas

@@ -1229,13 +1229,7 @@ type
           for class entries as the tree keeps always the same }
         if (not symtableprocentry.overloadchecked) and
            (symtableprocentry.owner.symtabletype=objectsymtable) and
-           (
-            (
-             (symtableprocentry.first_procdef.proctypeoption=potype_constructor) and
-             is_class(tdef(symtableprocentry.owner.defowner))
-            ) or
-            (po_overload in symtableprocentry.first_procdef.procoptions)
-           ) then
+           (po_overload in symtableprocentry.first_procdef.procoptions) then
          search_class_overloads(symtableprocentry);
 
          { when the class passed is defined in this unit we
@@ -1320,7 +1314,7 @@ type
                            while assigned(hp) do
                             begin
                               { Only compare visible parameters for the user }
-                              if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,false,true)>=te_equal then
+                              if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
                                begin
                                  found:=true;
                                  break;
@@ -2591,7 +2585,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.201  2003-10-29 22:01:20  florian
+  Revision 1.202  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.201  2003/10/29 22:01:20  florian
     * fixed passing of dyn. arrays to open array parameters
 
   Revision 1.200  2003/10/23 14:44:07  peter

+ 10 - 7
compiler/nobj.pas

@@ -634,7 +634,7 @@ implementation
                                       begin
                                         if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
                                            (not(pdoverload or hasoverloads) or
-                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
+                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
                                          begin
                                            if is_visible then
                                              procdefcoll^.hidden:=true;
@@ -652,7 +652,7 @@ implementation
                                          begin
                                            { we start a new virtual tree, hide the old }
                                            if (not(pdoverload or hasoverloads) or
-                                               (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) and
+                                               (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) and
                                               (tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
                                             begin
                                               if is_visible then
@@ -668,7 +668,7 @@ implementation
                                            { do nothing, the error will follow when adding the entry }
                                          end
                                         { same parameters }
-                                        else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal) then
+                                        else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal) then
                                          begin
                                            { overload is inherited }
                                            if (po_overload in procdefcoll^.data.procoptions) then
@@ -734,7 +734,7 @@ implementation
                                           if the new defintion has not the overload directive }
                                         if is_visible and
                                            ((not(pdoverload or hasoverloads)) or
-                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
+                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
                                           procdefcoll^.hidden:=true;
                                       end;
                                    end
@@ -744,7 +744,7 @@ implementation
                                        has not the overload directive }
                                      if is_visible and
                                         ((not pdoverload) or
-                                         (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
+                                         (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
                                        procdefcoll^.hidden:=true;
                                    end;
                                 end; { not hidden }
@@ -1057,7 +1057,7 @@ implementation
             for i:=1 to tprocsym(sym).procdef_count do
               begin
                 implprocdef:=tprocsym(sym).procdef[i];
-                if (compare_paras(proc.para,implprocdef.para,cp_none,false,false)>=te_equal) and
+                if (compare_paras(proc.para,implprocdef.para,cp_none,[])>=te_equal) and
                    (proc.proccalloption=implprocdef.proccalloption) then
                   begin
                     gintfgetcprocdef:=implprocdef;
@@ -1368,7 +1368,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.54  2003-10-29 19:48:50  peter
+  Revision 1.55  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.54  2003/10/29 19:48:50  peter
     * renamed mangeldname_prefix to make_mangledname and made it more
       generic
     * make_mangledname is now also used for internal threadvar/resstring

+ 6 - 3
compiler/pdecobj.pas

@@ -387,7 +387,7 @@ implementation
                        { Insert hidden parameters }
                        calc_parast(readprocdef);
                        { search procdefs matching readprocdef }
-                       p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,true,false);
+                       p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,[cpo_allowdefaults]);
                        if not assigned(p.readaccess.procdef) then
                          Message(parser_e_ill_property_access_sym);
                      end;
@@ -431,7 +431,7 @@ implementation
                        { Insert hidden parameters }
                        calc_parast(writeprocdef);
                        { search procdefs matching writeprocdef }
-                       p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,true,false);
+                       p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,[cpo_allowdefaults]);
                        if not assigned(p.writeaccess.procdef) then
                          Message(parser_e_ill_property_access_sym);
                      end;
@@ -1157,7 +1157,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2003-10-22 15:22:33  peter
+  Revision 1.72  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.71  2003/10/22 15:22:33  peter
     * fixed unitsym-globalsymtable relation so the uses of a unit
       is counted correctly
 

+ 6 - 3
compiler/pdecsub.pas

@@ -1892,7 +1892,7 @@ const
               ) or
               { check arguments }
               (
-               (compare_paras(pd.para,hd.para,cp_none,false,false)>=te_equal) and
+               (compare_paras(pd.para,hd.para,cp_none,[])>=te_equal) and
                { for operators equal_paras is not enough !! }
                ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
                 equal_defs(hd.rettype.def,pd.rettype.def))
@@ -1911,7 +1911,7 @@ const
                       (
                        (m_repeat_forward in aktmodeswitches) and
                        (not((pd.maxparacount=0) or
-                            (compare_paras(pd.para,hd.para,cp_all,false,false)>=te_equal)))
+                            (compare_paras(pd.para,hd.para,cp_all,[])>=te_equal)))
                       ) or
                       (
                        ((m_repeat_forward in aktmodeswitches) or
@@ -2132,7 +2132,10 @@ const
 end.
 {
   $Log$
-  Revision 1.149  2003-10-28 15:36:01  peter
+  Revision 1.150  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.149  2003/10/28 15:36:01  peter
     * absolute to object field supported, fixes tb0458
 
   Revision 1.148  2003/10/07 21:14:33  peter

+ 15 - 16
compiler/symsym.pas

@@ -31,7 +31,7 @@ interface
        { target }
        globtype,globals,
        { symtable }
-       symconst,symbase,symtype,symdef,
+       symconst,symbase,symtype,symdef,defcmp,
        { ppu }
        ppu,symppu,
        cclasses,symnot,
@@ -132,7 +132,7 @@ interface
           procedure deref;override;
           procedure addprocdef(p:tprocdef);
           procedure addprocdef_deref(const d:tderef);
-          procedure add_para_match_to(Aprocsym:Tprocsym);
+          procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
           procedure concat_procdefs_to(s:Tprocsym);
           procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
           function first_procdef:Tprocdef;
@@ -141,8 +141,7 @@ interface
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
           function search_procdef_bypara(params:Tlinkedlist;
                                          retdef:tdef;
-                                         allowconvert,
-                                         allowdefault:boolean):Tprocdef;
+                                         cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function search_procdef_unary_operator(firstpara:Tdef):Tprocdef;
           function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
@@ -375,7 +374,7 @@ implementation
        { target }
        systems,
        { symtable }
-       defutil,defcmp,symtable,
+       defutil,symtable,
 {$ifdef GDB}
        gdb,
 {$endif GDB}
@@ -866,7 +865,7 @@ implementation
 
     procedure tprocsym.deref;
       var
-         prev,hp,p : pprocdeflist;
+         p : pprocdeflist;
       begin
          { We have removed the overloaded entries, because they
            are not valid anymore and we can't deref them because
@@ -875,13 +874,11 @@ implementation
          unchain_overload;
          { Deref our own procdefs }
          p:=pdlistfirst;
-         prev:=nil;
          while assigned(p) do
            begin
              if not p^.own then
                internalerror(200310291);
              p^.def:=tprocdef(p^.defderef.resolve);
-             prev:=p;
              p:=p^.next;
            end;
       end;
@@ -953,14 +950,14 @@ implementation
       end;
 
 
-    procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
+    procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
       var
         pd:pprocdeflist;
       begin
         pd:=pdlistfirst;
         while assigned(pd) do
           begin
-            if Aprocsym.search_procdef_bypara(pd^.def.para,nil,false,true)=nil then
+            if Aprocsym.search_procdef_bypara(pd^.def.para,nil,cpoptions)=nil then
               Aprocsym.addprocdef(pd^.def);
             pd:=pd^.next;
           end;
@@ -1050,8 +1047,7 @@ implementation
 
     function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
                                             retdef:tdef;
-                                            allowconvert,
-                                            allowdefault:boolean):Tprocdef;
+                                            cpoptions:tcompare_paras_options):Tprocdef;
       var
         pd : pprocdeflist;
         eq : tequaltype;
@@ -1065,11 +1061,11 @@ implementation
            else
              eq:=te_equal;
            if (eq>=te_equal) or
-              (allowconvert and (eq>te_incompatible)) then
+              ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
             begin
-              eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault,false);
+              eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,cpoptions);
               if (eq>=te_equal) or
-                 (allowconvert and (eq>te_incompatible)) then
+                 ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
                 begin
                   search_procdef_bypara:=pd^.def;
                   break;
@@ -2687,7 +2683,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.133  2003-10-29 21:56:28  peter
+  Revision 1.134  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.133  2003/10/29 21:56:28  peter
     * procsym.deref derefs only own procdefs
     * reset paracount in procdef.deref so a second deref doesn't increase
       the paracounts to invalid values

+ 6 - 3
compiler/symtable.pas

@@ -262,7 +262,7 @@ implementation
       { target }
       systems,
       { symtable }
-      symutil,
+      symutil,defcmp,
       { module }
       fmodule,
 {$ifdef GDB}
@@ -2131,7 +2131,7 @@ implementation
                internalerror(200111022);
               if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner)) then
                begin
-                 srsym.add_para_match_to(Aprocsym);
+                 srsym.add_para_match_to(Aprocsym,[cpo_ignorehidden,cpo_allowdefaults]);
                  { we can stop if the overloads were already added
                   for the found symbol }
                  if srsym.overloadchecked then
@@ -2297,7 +2297,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.120  2003-10-23 14:44:07  peter
+  Revision 1.121  2003-10-30 16:23:13  peter
+    * don't search for overloads in parents for constructors
+
+  Revision 1.120  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation