* overload fixes (merged)

compiler/psub.pas

@@ -44,6 +44,7 @@ function  is_proc_directive(tok:ttoken):boolean;
 procedure parse_var_proc_directives(var sym : psym);
 procedure parse_object_proc_directives(var sym : pprocsym);
 procedure read_proc;
+function check_identical_proc(var p : pprocdef) : boolean;
 
 implementation
 
@@ -1217,7 +1218,7 @@ end;
 
 {***************************************************************************}
 
-function check_identical(var p : pprocdef) : boolean;
+function check_identical_proc(var p : pprocdef) : boolean;
 {
   Search for idendical definitions,
   if there is a forward, then kill this.
@@ -1232,7 +1233,7 @@ var
   ad,fd : psym;
   s : string;
 begin
-  check_identical:=false;
+  check_identical_proc:=false;
   p:=nil;
   pd:=aktprocsym^.definition;
   if assigned(pd) then
@@ -1244,44 +1245,21 @@ begin
         while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
          begin
            hd:=pd^.nextoverloaded;
-           { check for allowing overloading }
-           if not(m_fpc in aktmodeswitches) then
-            begin
-              { if one of the two has overload directive then
-                we should issue an other error }
-              if (po_overload in pd^.procoptions) or
-                 (po_overload in hd^.procoptions) then
-               begin
-                 { one a forwarddef and the other not then the not may not have
-                   the directive as in D5 (PFV) }
-                 if hd^.forwarddef and (not pd^.forwarddef) then
-                  begin
-                    if (po_overload in pd^.procoptions) then
-                     Message1(parser_e_proc_dir_not_allowed_in_implementation,'OVERLOAD');
-                  end
-                 else
-                  if not((po_overload in pd^.procoptions) and
-                         ((po_overload in hd^.procoptions))) then
-                   Message1(parser_e_no_overload_for_all_procs,aktprocsym^.name);
-               end
-              else
-               begin
-                 if not(hd^.forwarddef) then
-                  Message(parser_e_procedure_overloading_is_off);
-               end;
-            end;
+
            { check the parameters }
            if (not(m_repeat_forward in aktmodeswitches) and
                (aktprocsym^.definition^.para^.count=0)) or
               (equal_paras(aktprocsym^.definition^.para,hd^.para,cp_none) and
               { for operators equal_paras is not enough !! }
               ((aktprocsym^.definition^.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
-               is_equal(pd^.nextoverloaded^.rettype.def,aktprocsym^.definition^.rettype.def))) then
+               is_equal(hd^.rettype.def,aktprocsym^.definition^.rettype.def))) then
              begin
                if not equal_paras(aktprocsym^.definition^.para,hd^.para,cp_all) and
-                 ((m_repeat_forward in aktmodeswitches) or (aktprocsym^.definition^.para^.count>0)) then
+                  ((m_repeat_forward in aktmodeswitches) or
+                   (aktprocsym^.definition^.para^.count>0)) then
                  begin
-                    Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
+                    MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
+                                aktprocsym^.demangledName);
                     exit;
                  end;
                if hd^.forwarddef then
@@ -1293,38 +1271,36 @@ begin
                       (not(is_equal(hd^.rettype.def,aktprocsym^.definition^.rettype.def)) and
                       (m_repeat_forward in aktmodeswitches)) then
                      begin
-                       Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
+                       MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
+                                   aktprocsym^.demangledName);
                        exit;
                      end;
-                 { Check calling convention, no check for internconst,internproc which
-                   are only defined in interface or implementation }
+                   { Check calling convention, no check for internconst,internproc which
+                     are only defined in interface or implementation }
                    if (hd^.proccalloptions-[pocall_internconst,pocall_internproc]<>
                        aktprocsym^.definition^.proccalloptions-[pocall_internconst,pocall_internproc]) then
                     begin
                       { only trigger an error, becuase it doesn't hurt }
-                      Message(parser_e_call_convention_dont_match_forward);
+                      MessagePos(aktprocsym^.definition^.fileinfo,parser_e_call_convention_dont_match_forward);
                       { set the mangledname to the interface name so it doesn't trigger
                         the Note about different manglednames (PFV) }
                       aktprocsym^.definition^.setmangledname(hd^.mangledname);
                     end;
-                 { manglednames are equal? }
+                   { check for overload directive, which is not allowed in implementation
+                     if already declared in forward, D5 compatible (PFV) }
+                   if not(aktprocsym^.definition^.forwarddef) and
+                      (po_overload in aktprocsym^.definition^.procoptions) then
+                     MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_proc_dir_not_allowed_in_implementation,
+                                 'OVERLOAD');
+                   { manglednames are equal? }
                    hd^.count:=false;
                    if (m_repeat_forward in aktmodeswitches) or
                       aktprocsym^.definition^.haspara then
                     begin
                       if (hd^.mangledname<>aktprocsym^.definition^.mangledname) then
                        begin
-                         { When overloading is not possible then we issue an error }
-                         { This is not true, tp7/delphi don't give an error when a renamed
-                           type is used in the other declaration (PFV)
-                           if not(m_repeat_forward in aktmodeswitches) then
-                          begin
-                            Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
-                            exit;
-                          end; }
-
                          if not(po_external in aktprocsym^.definition^.procoptions) then
-                           Message2(parser_n_interface_name_diff_implementation_name,hd^.mangledname,
+                           MessagePos2(aktprocsym^.definition^.fileinfo,parser_n_interface_name_diff_implementation_name,hd^.mangledname,
                              aktprocsym^.definition^.mangledname);
                        { reset the mangledname of the interface part to be sure }
                        { this is wrong because the mangled name might have been used already !! }
@@ -1333,7 +1309,7 @@ begin
                           hd^.setmangledname(aktprocsym^.definition^.mangledname);
                        { so we need to keep the name of interface !!
                          No!!!! The procedure directives can change the mangledname.
-                         I fixed this by first calling check_identical and then doing
+                         I fixed this by first calling check_identical_proc and then doing
                          the proc directives, but this is not a good solution.(DM)}
                          { this is also wrong (PM)
                          aktprocsym^.definition^.setmangledname(hd^.mangledname);}
@@ -1346,8 +1322,9 @@ begin
                        { parameters...                      }
                          if hd^.forwarddef and aktprocsym^.definition^.forwarddef then
                            begin
-                             Message1(parser_e_function_already_declared_public_forward,aktprocsym^.demangledName);
-                             Check_identical:=true;
+                             MessagePos1(aktprocsym^.definition^.fileinfo,
+                                         parser_e_function_already_declared_public_forward,aktprocsym^.demangledName);
+                             check_identical_proc:=true;
                            { Remove other forward from the list to reduce errors }
                              pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
                              exit;
@@ -1361,7 +1338,7 @@ begin
                                  s:=ad^.name;
                                  if s<>fd^.name then
                                    begin
-                                     Message3(parser_e_header_different_var_names,
+                                     MessagePos3(aktprocsym^.definition^.fileinfo,parser_e_header_different_var_names,
                                        aktprocsym^.name,s,fd^.name);
                                      break;
                                    end;
@@ -1386,6 +1363,7 @@ begin
                  { Alert! All fields of aktprocsym^.definition that are modified
                    by the procdir handlers must be copied here!.}
                    hd^.forwarddef:=false;
+                   hd^.hasforward:=true;
                    hd^.proccalloptions:=hd^.proccalloptions + aktprocsym^.definition^.proccalloptions;
                    hd^.procoptions:=hd^.procoptions + aktprocsym^.definition^.procoptions;
                    if aktprocsym^.definition^.extnumber=-1 then
@@ -1406,24 +1384,54 @@ begin
                    else
                      p:=pd;
                    aktprocsym^.definition:=hd;
-                   check_identical:=true;
+                   check_identical_proc:=true;
                  end
                else
                { abstract methods aren't forward defined, but this }
                { needs another error message                   }
                  if not(po_abstractmethod in pd^.nextoverloaded^.procoptions) then
-                   Message(parser_e_overloaded_have_same_parameters)
+                   MessagePos(aktprocsym^.definition^.fileinfo,parser_e_overloaded_have_same_parameters)
                  else
-                   Message(parser_e_abstract_no_definition);
+                   MessagePos(aktprocsym^.definition^.fileinfo,parser_e_abstract_no_definition);
                break;
              end;
+
+           { check for allowing overload directive }
+           if not(m_fpc in aktmodeswitches) then
+            begin
+              { overload directive turns on overloading }
+              if ((po_overload in aktprocsym^.definition^.procoptions) or
+                  ((po_overload in hd^.procoptions))) then
+               begin
+                 { check if all procs have overloading, but not if the proc was
+                   already declared forward, then the check is already done }
+                 if not(hd^.hasforward) and
+                    (aktprocsym^.definition^.forwarddef=hd^.forwarddef) and
+                    not((po_overload in aktprocsym^.definition^.procoptions) and
+                        ((po_overload in hd^.procoptions))) then
+                  begin
+                    MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_no_overload_for_all_procs,aktprocsym^.name);
+                    break;
+                  end;
+               end
+              else
+               begin
+                 if not(hd^.forwarddef) then
+                  begin
+                    MessagePos(aktprocsym^.definition^.fileinfo,parser_e_procedure_overloading_is_off);
+                    break;
+                  end;
+               end;
+            end;
+
+           { try next overloaded }
            pd:=pd^.nextoverloaded;
          end;
       end
      else
       begin
       { there is no overloaded, so its always identical with itself }
-        check_identical:=true;
+        check_identical_proc:=true;
       end;
    end;
 { insert opsym only in the right symtable }
@@ -1963,7 +1971,7 @@ begin
    aktfilepos:=aktprocsym^.definition^.fileinfo;
 
 { search for forward declarations }
-   if not check_identical(prevdef) then
+   if not check_identical_proc(prevdef) then
      begin
      { A method must be forward defined (in the object declaration) }
        if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
@@ -1984,8 +1992,8 @@ begin
         end
      end;
 
-{ set return type here, becuase the aktprocsym^.definition can be
-  changed by check_identical (PFV) }
+   { set return type here, becuase the aktprocsym^.definition can be
+     changed by check_identical_proc (PFV) }
    procinfo^.returntype.def:=aktprocsym^.definition^.rettype.def;
 
 {$ifdef i386}
@@ -2066,7 +2074,10 @@ end.
 
 {
   $Log$
-  Revision 1.4  2000-07-30 17:04:43  peter
+  Revision 1.5  2000-08-06 14:17:15  peter
+    * overload fixes (merged)
+
+  Revision 1.4  2000/07/30 17:04:43  peter
     * merged fixes
 
   Revision 1.3  2000/07/13 12:08:27  michael

compiler/ptype.pas

@@ -958,6 +958,8 @@ uses
              aktclass:=new(pobjectdef,init(n,nil));
         end;
 
+      var
+        temppd : pprocdef;
       begin
          {Nowadays aktprocsym may already have a value, so we need to save
           it.}
@@ -1125,6 +1127,8 @@ uses
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
+                      { check if there are duplicates }
+                      check_identical_proc(temppd);
                       if (po_msgint in aktprocsym^.definition^.procoptions) then
                         include(aktclass^.objectoptions,oo_has_msgint);
 
@@ -1593,7 +1597,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.4  2000-07-30 17:04:43  peter
+  Revision 1.5  2000-08-06 14:17:15  peter
+    * overload fixes (merged)
+
+  Revision 1.4  2000/07/30 17:04:43  peter
     * merged fixes
 
   Revision 1.3  2000/07/13 12:08:27  michael

compiler/symdef.inc

@@ -2629,6 +2629,7 @@
 {$endif newcg}
          forwarddef:=true;
          interfacedef:=false;
+         hasforward:=false;
          _class := nil;
          code:=nil;
          regvarinfo := nil;
@@ -2671,6 +2672,7 @@
          localst:=nil;
          forwarddef:=false;
          interfacedef:=false;
+         hasforward:=false;
          code := nil;
          regvarinfo := nil;
          lastref:=nil;
@@ -4193,7 +4195,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.5  2000-08-03 13:17:26  jonas
+  Revision 1.6  2000-08-06 14:17:15  peter
+    * overload fixes (merged)
+
+  Revision 1.5  2000/08/03 13:17:26  jonas
     + allow regvars to be used inside inlined procs, which required  the
       following changes:
         + load regvars in genentrycode/free them in genexitcode (cgai386)

compiler/symdefh.inc

@@ -422,6 +422,8 @@
           forwarddef,
           { true if the procedure is declared in the interface }
           interfacedef : boolean;
+          { true if the procedure has a forward declaration }
+          hasforward : boolean;
           { check the problems of manglednames }
           count      : boolean;
           is_used    : boolean;
@@ -537,7 +539,10 @@
 
 {
   $Log$
-  Revision 1.5  2000-08-03 13:17:26  jonas
+  Revision 1.6  2000-08-06 14:17:15  peter
+    * overload fixes (merged)
+
+  Revision 1.5  2000/08/03 13:17:26  jonas
     + allow regvars to be used inside inlined procs, which required  the
       following changes:
         + load regvars in genentrycode/free them in genexitcode (cgai386)