* fixed overload checking of virtual and class methods (mantis #8140)

* fixed "overload" keyword checking in Delphi mode

git-svn-id: trunk@6074 -

.gitattributes

@@ -7130,6 +7130,10 @@ tests/webtbf/tw7438a.pp svneol=native#text/plain
 tests/webtbf/tw7989.pp svneol=native#text/plain
 tests/webtbf/tw8019.pp svneol=native#text/plain
 tests/webtbf/tw8031.pp svneol=native#text/plain
+tests/webtbf/tw8140a.pp svneol=native#text/plain
+tests/webtbf/tw8140c.pp svneol=native#text/plain
+tests/webtbf/tw8140d.pp svneol=native#text/plain
+tests/webtbf/tw8140e.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain
@@ -7964,6 +7968,11 @@ tests/webtbs/tw8028.pp svneol=native#text/plain
 tests/webtbs/tw8049.pp svneol=native#text/plain
 tests/webtbs/tw8055.pp svneol=native#text/plain
 tests/webtbs/tw8090.pp svneol=native#text/plain
+tests/webtbs/tw8140.pp svneol=native#text/plain
+tests/webtbs/tw8140b.pp svneol=native#text/plain
+tests/webtbs/tw8140f.pp svneol=native#text/plain
+tests/webtbs/tw8140g.pp svneol=native#text/plain
+tests/webtbs/tw8140h.pp svneol=native#text/plain
 tests/webtbs/tw8141.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/nobj.pas

@@ -193,7 +193,8 @@ implementation
                   begin
                     oldpd:=pprocdefentry(VMTSymentry.ProcdefList[i])^.data;
                     if (oldpd._class=pd._class) and
-                       ((po_overload in pd.procoptions)<>(po_overload in oldpd.procoptions)) then
+                       (not(po_overload in pd.procoptions) or
+                        not(po_overload in oldpd.procoptions)) then
                       begin
                         MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname);
                         { recover }
@@ -374,7 +375,7 @@ implementation
                          the procedure to override.
                          If we are starting a new virtual tree then hide the old tree }
                        if not(po_overridingmethod in pd.procoptions) and
-                          not pdoverload then
+                          not (pdoverload or hasoverloads) then
                         begin
                           if is_visible then
                             procdefcoll^.hidden:=true;
@@ -403,7 +404,7 @@ implementation
                   has not the overload directive }
                 if is_visible and
                    (
-                    (not pdoverload) or
+                    not(pdoverload or hasoverloads) or
                     (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)
                    ) then
                   procdefcoll^.hidden:=true;

tests/webtbf/tw8140a.pp

@@ -0,0 +1,30 @@
+{ %fail }
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+begin
+end.

tests/webtbf/tw8140c.pp

@@ -0,0 +1,45 @@
+{ %fail }
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+ tc = class(tinterfacedobject,imselocate2)
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ function tc.locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+
+begin
+end.
+

tests/webtbf/tw8140d.pp

@@ -0,0 +1,52 @@
+{ %fail }
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty; overload;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+ tc = class(tinterfacedobject,imselocate2)
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield; overload;
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+ function tc.locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+ function tc.locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+
+begin
+end.
+

tests/webtbf/tw8140e.pp

@@ -0,0 +1,47 @@
+{ %fail }
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty; overload;
+ end;
+
+ tc = class(tinterfacedobject,imselocate2)
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;overload;
+ end;
+
+ function tc.locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+
+begin
+end.
+

tests/webtbs/tw8140.pp

@@ -0,0 +1,27 @@
+{ %norun }
+
+{$mode objfpc}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+begin
+end.

tests/webtbs/tw8140b.pp

@@ -0,0 +1,33 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+begin
+end.
+

tests/webtbs/tw8140f.pp

@@ -0,0 +1,51 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty; overload;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty; overload;
+ end;
+
+ tc = class(tinterfacedobject,imselocate2)
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;overload;
+   function locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;overload;
+ end;
+
+ function tc.locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+ function tc.locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+
+begin
+end.
+

tests/webtbs/tw8140g.pp

@@ -0,0 +1,27 @@
+{ %norun }
+
+{$mode objfpc}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+begin
+end.

tests/webtbs/tw8140h.pp

@@ -0,0 +1,49 @@
+{ %norun }
+
+{$mode objfpc}
+
+type
+ inullinterface = interface
+  //no referencecount, only for fpc, not available in delphi
+ end;
+
+ locateresultty = (loc_timeout,loc_notfound,loc_ok); 
+
+ tfield = class
+ end;
+
+ locateoptionty = (loo_caseinsensitive,loo_partialkey,
+                        loo_noforeward,loo_nobackward);
+ locateoptionsty  = set of locateoptionty;
+
+ imselocate = interface(inullinterface)['{2680958F-F954-DA11-9015-00C0CA1308FF}']
+   function locate(const key: integer; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ imselocate2 = interface(imselocate)['{2680958F-F954-DA11-9015-00C0CA130801}']
+   function locate(const key: string; const field: tfield; 
+                 const options: locateoptionsty = []): locateresultty;
+ end;
+
+ tc = class(tinterfacedobject,imselocate2)
+   function locate(const key: longint; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   function locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+ end;
+
+ function tc.locate(const key: string; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+ function tc.locate(const key: longint; const field: tfield;
+                     const options: locateoptionsty = []): locateresultty;
+   begin
+   end;
+
+
+begin
+end.
+