Browse Source

* procvar default value support

peter 22 years ago
parent
commit
a3c14e9c2d
3 changed files with 48 additions and 35 deletions
  1. 7 3
      compiler/defcmp.pas
  2. 35 29
      compiler/ncal.pas
  3. 6 3
      compiler/pdecsub.pas

+ 7 - 3
compiler/defcmp.pas

@@ -36,7 +36,7 @@ interface
      type
      type
        { if acp is cp_all the var const or nothing are considered equal }
        { if acp is cp_all the var const or nothing are considered equal }
        tcompare_paras_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_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue);
        tcompare_paras_options = set of tcompare_paras_option;
        tcompare_paras_options = set of tcompare_paras_option;
 
 
        tconverttype = (
        tconverttype = (
@@ -1184,7 +1184,8 @@ implementation
               if eq<lowesteq then
               if eq<lowesteq then
                 lowesteq:=eq;
                 lowesteq:=eq;
               { also check default value if both have it declared }
               { also check default value if both have it declared }
-              if assigned(currpara1.defaultvalue) and
+              if (cpo_comparedefaultvalue in cpoptions) and
+                 assigned(currpara1.defaultvalue) and
                  assigned(currpara2.defaultvalue) then
                  assigned(currpara2.defaultvalue) then
                begin
                begin
                  if not equal_constsym(tconstsym(currpara1.defaultvalue),tconstsym(currpara2.defaultvalue)) then
                  if not equal_constsym(tconstsym(currpara1.defaultvalue),tconstsym(currpara2.defaultvalue)) then
@@ -1248,7 +1249,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.36  2003-11-04 22:30:15  florian
+  Revision 1.37  2003-11-10 19:09:29  peter
+    * procvar default value support
+
+  Revision 1.36  2003/11/04 22:30:15  florian
     + type cast variant<->enum
     + type cast variant<->enum
     * cnv. node second pass uses now as well helper wrappers
     * cnv. node second pass uses now as well helper wrappers
 
 

+ 35 - 29
compiler/ncal.pas

@@ -56,7 +56,6 @@ interface
        tcallnode = class(tbinarynode)
        tcallnode = class(tbinarynode)
        private
        private
           paravisible  : boolean;
           paravisible  : boolean;
-          paralength   : smallint;
           function  candidates_find:pcandidate;
           function  candidates_find:pcandidate;
           procedure candidates_free(procs:pcandidate);
           procedure candidates_free(procs:pcandidate);
           procedure candidates_list(procs:pcandidate;all:boolean);
           procedure candidates_list(procs:pcandidate;all:boolean);
@@ -88,6 +87,8 @@ interface
           procdefinitionderef : tderef;
           procdefinitionderef : tderef;
           { tree that contains the pointer to the object for this method }
           { tree that contains the pointer to the object for this method }
           methodpointer  : tnode;
           methodpointer  : tnode;
+          { number of parameters passed from the source, this does not include the hidden parameters }
+          paralength   : smallint;
           { inline function body }
           { inline function body }
           inlinecode : tnode;
           inlinecode : tnode;
           { varargs tparaitems }
           { varargs tparaitems }
@@ -2001,7 +2002,9 @@ type
                   pt:=tcallparanode(pt.right);
                   pt:=tcallparanode(pt.right);
                   dec(lastpara);
                   dec(lastpara);
                 end;
                 end;
-              if assigned(pt) or assigned(currpara) then
+              if assigned(pt) or
+                 (assigned(currpara) and
+                  not assigned(currpara.defaultvalue)) then
                 begin
                 begin
                    if assigned(pt) then
                    if assigned(pt) then
                      aktfilepos:=pt.fileinfo;
                      aktfilepos:=pt.fileinfo;
@@ -2130,34 +2133,34 @@ type
 
 
                    candidates_free(procs);
                    candidates_free(procs);
                end; { end of procedure to call determination }
                end; { end of procedure to call determination }
-
-              { add needed default parameters }
-              if assigned(procdefinition) and
-                 (paralength<procdefinition.maxparacount) then
-               begin
-                 currpara:=tparaitem(procdefinition.Para.first);
-                 i:=0;
-                 while (i<paralength) do
-                  begin
-                    if not assigned(currpara) then
-                      internalerror(200306181);
-                    if not currpara.is_hidden then
-                      inc(i);
-                    currpara:=tparaitem(currpara.next);
-                  end;
-                 while assigned(currpara) and
-                       currpara.is_hidden do
-                   currpara:=tparaitem(currpara.next);
-                 while assigned(currpara) do
-                  begin
-                    if not assigned(currpara.defaultvalue) then
-                     internalerror(200212142);
-                    left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
-                    currpara:=tparaitem(currpara.next);
-                  end;
-               end;
            end;
            end;
 
 
+          { add needed default parameters }
+          if assigned(procdefinition) and
+             (paralength<procdefinition.maxparacount) then
+           begin
+             currpara:=tparaitem(procdefinition.Para.first);
+             i:=0;
+             while (i<paralength) do
+              begin
+                if not assigned(currpara) then
+                  internalerror(200306181);
+                if not currpara.is_hidden then
+                  inc(i);
+                currpara:=tparaitem(currpara.next);
+              end;
+             while assigned(currpara) and
+                   currpara.is_hidden do
+               currpara:=tparaitem(currpara.next);
+             while assigned(currpara) do
+              begin
+                if not assigned(currpara.defaultvalue) then
+                 internalerror(200212142);
+                left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
+                currpara:=tparaitem(currpara.next);
+              end;
+           end;
+           
           { handle predefined procedures }
           { handle predefined procedures }
           is_const:=(po_internconst in procdefinition.procoptions) and
           is_const:=(po_internconst in procdefinition.procoptions) and
                     ((block_type in [bt_const,bt_type]) or
                     ((block_type in [bt_const,bt_type]) or
@@ -2586,7 +2589,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.205  2003-11-06 15:54:32  peter
+  Revision 1.206  2003-11-10 19:09:29  peter
+    * procvar default value support
+
+  Revision 1.205  2003/11/06 15:54:32  peter
     * fixed calling classmethod for other object from classmethod
     * fixed calling classmethod for other object from classmethod
 
 
   Revision 1.204  2003/11/01 16:17:48  peter
   Revision 1.204  2003/11/01 16:17:48  peter

+ 6 - 3
compiler/pdecsub.pas

@@ -1911,7 +1911,7 @@ const
               ) or
               ) or
               { check arguments }
               { check arguments }
               (
               (
-               (compare_paras(pd.para,hd.para,cp_none,[])>=te_equal) and
+               (compare_paras(pd.para,hd.para,cp_none,[cpo_comparedefaultvalue])>=te_equal) and
                { for operators equal_paras is not enough !! }
                { for operators equal_paras is not enough !! }
                ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
                ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
                 equal_defs(hd.rettype.def,pd.rettype.def))
                 equal_defs(hd.rettype.def,pd.rettype.def))
@@ -1930,7 +1930,7 @@ const
                       (
                       (
                        (m_repeat_forward in aktmodeswitches) and
                        (m_repeat_forward in aktmodeswitches) and
                        (not((pd.maxparacount=0) or
                        (not((pd.maxparacount=0) or
-                            (compare_paras(pd.para,hd.para,cp_all,[])>=te_equal)))
+                            (compare_paras(pd.para,hd.para,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
                       ) or
                       ) or
                       (
                       (
                        ((m_repeat_forward in aktmodeswitches) or
                        ((m_repeat_forward in aktmodeswitches) or
@@ -2151,7 +2151,10 @@ const
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.152  2003-11-07 15:58:32  florian
+  Revision 1.153  2003-11-10 19:09:29  peter
+    * procvar default value support
+
+  Revision 1.152  2003/11/07 15:58:32  florian
     * Florian's culmutative nr. 1; contains:
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions
       - arm softfloat calling conventions