* fixed one regression in r5682: implementation declarations with a

    calling convention that has different hidden parameters than the
    interface declaration no longer compiled in Delphi mode (e.g.
    webtbs/tw7329.pp on i386)
  * fixed remaining declaration parsing incompatibilities in TP/Delphi
    modes (other modes already gave errors for the things below):
    * give an error for "function a: byte;" in interface followed by
      "procedure a;" in implementation ("function a;" in implementation
      still allowed as in TP/Delphi)
    * give an error for "function a(b: byte):byte" in interface
      followed by "function a: byte;" in implementation (if one parameter
      or return type is specified in implementation, everything must
      be repeated -- "function a;" still allowed)
  * copied webtbs/tw0890.pp to webtbf/tw0890a.pp since it now correctly
    fails, and modified webtbs/tw0890.pp so it doesn't fail with the
    new code

git-svn-id: trunk@5688 -

.gitattributes

@@ -5723,6 +5723,8 @@ tests/tbf/tb0187.pp svneol=native#text/plain
 tests/tbf/tb0188.pp svneol=native#text/plain
 tests/tbf/tb0189.pp svneol=native#text/plain
 tests/tbf/tb0190.pp svneol=native#text/plain
+tests/tbf/tb0191.pp svneol=native#text/plain
+tests/tbf/tb0192.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -6236,6 +6238,7 @@ tests/tbs/tb0513.pp svneol=native#text/plain
 tests/tbs/tb0514.pp svneol=native#text/plain
 tests/tbs/tb0515.pp svneol=native#text/plain
 tests/tbs/tb0516.pp svneol=native#text/plain
+tests/tbs/tb0517.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -6819,6 +6822,7 @@ tests/webtbf/tw0840.pp svneol=native#text/plain
 tests/webtbf/tw0855.pp svneol=native#text/plain
 tests/webtbf/tw0856.pp svneol=native#text/plain
 tests/webtbf/tw0890.pp svneol=native#text/plain
+tests/webtbf/tw0890a.pp svneol=native#text/plain
 tests/webtbf/tw0893.pp svneol=native#text/plain
 tests/webtbf/tw0896.pp svneol=native#text/plain
 tests/webtbf/tw0896a.pp svneol=native#text/plain

compiler/pdecsub.pas

@@ -918,6 +918,7 @@ implementation
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
                     begin
+                      include(pd.procoptions,po_function);
                       if try_to_consume(_COLON) then
                        begin
                          inc(testcurobject);
@@ -2408,8 +2409,9 @@ const
         curridx,
         fwidx,
         i       : longint;
-        forwardfound : boolean;
         po_comp : tprocoptions;
+        paracompopt: tcompare_paras_options;
+        forwardfound : boolean;
       begin
         forwardfound:=false;
 
@@ -2453,37 +2455,11 @@ const
                  begin
                    forwardfound:=true;
 
-                   { Check if the procedure type and return type are correct,
-                     also the parameters must match also with the type }
-                   if (fwpd.proctypeoption<>currpd.proctypeoption) or
-                      (
-                       (not((currpd.maxparacount=0) or
-                            (compare_paras(currpd.paras,fwpd.paras,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
-                      ) or
-                      (
-                       ((m_repeat_forward in current_settings.modeswitches) or
-                        not(is_void(currpd.returndef))) and
-                       (not equal_defs(fwpd.returndef,currpd.returndef))) then
-                     begin
-                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
-                                   currpd.fullprocname(false));
-                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                       break;
-                     end;
-
-                   { Check if both are declared forward }
-                   if fwpd.forwarddef and currpd.forwarddef then
-                    begin
-                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
-                                  currpd.fullprocname(false));
-                    end;
-
-                   { internconst or internproc only need to be defined once }
-                   if (fwpd.proccalloption=pocall_internproc) then
-                    currpd.proccalloption:=fwpd.proccalloption
+                   if (m_repeat_forward in current_settings.modeswitches) or
+                      (fwpd.proccalloption<>currpd.proccalloption) then
+                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue]
                    else
-                    if (currpd.proccalloption=pocall_internproc) then
-                     fwpd.proccalloption:=currpd.proccalloption;
+                     paracompopt:=[cpo_comparedefaultvalue];
 
                    { Check calling convention }
                    if (fwpd.proccalloption<>currpd.proccalloption) then
@@ -2516,12 +2492,40 @@ const
                         end;
                     end;
 
+                   { Check if the procedure type and return type are correct,
+                     also the parameters must match also with the type }
+                   if ((m_repeat_forward in current_settings.modeswitches) or
+                       (currpd.maxparacount<>0) or
+                       (not(is_void(currpd.returndef)))) and
+                      ((compare_paras(currpd.paras,fwpd.paras,cp_all,paracompopt)<te_equal) or
+                       (not equal_defs(fwpd.returndef,currpd.returndef))) then
+                     begin
+                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
+                                   fwpd.fullprocname(false));
+                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                       break;
+                     end;
+
+                   { Check if both are declared forward }
+                   if fwpd.forwarddef and currpd.forwarddef then
+                    begin
+                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
+                                  currpd.fullprocname(false));
+                    end;
+
+                   { internconst or internproc only need to be defined once }
+                   if (fwpd.proccalloption=pocall_internproc) then
+                    currpd.proccalloption:=fwpd.proccalloption
+                   else
+                    if (currpd.proccalloption=pocall_internproc) then
+                     fwpd.proccalloption:=currpd.proccalloption;
+
                    { Check procedure options, Delphi requires that class is
                      repeated in the implementation for class methods }
                    if (m_fpc in current_settings.modeswitches) then
-                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
+                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt,po_function]
                    else
-                     po_comp:=[po_classmethod,po_methodpointer];
+                     po_comp:=[po_classmethod,po_methodpointer,po_function];
 
                    if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) then
                      begin

compiler/symconst.pas

@@ -271,7 +271,9 @@ type
     { importing }
     po_has_importdll,
     po_has_importname,
-    po_kylixlocal
+    po_kylixlocal,
+    { this is a function and not a procedure -- needed for tbf/tb0175 }
+    po_function
   );
   tprocoptions=set of tprocoption;
 

tests/tbf/tb0191.pp

@@ -0,0 +1,20 @@
+{ %norun }
+{ %fail }
+{$mode delphi}
+unit tb0191;
+
+interface
+
+type
+  tii = interface(iunknown) end;
+  ti2 = interface(tii) end;
+
+function a(b: longint): tii; stdcall;
+
+implementation
+
+function a:tii;
+begin
+end;
+
+end.

tests/tbf/tb0192.pp

@@ -0,0 +1,20 @@
+{ %norun }
+{ %fail }
+{$mode delphi}
+unit tb0192;
+
+interface
+
+type
+  tii = interface(iunknown) end;
+  ti2 = interface(iunknown) end;
+
+function a: tii; stdcall;
+
+implementation
+
+function a:ti2;
+begin
+end;
+
+end.

tests/tbs/tb0517.pp

@@ -0,0 +1,19 @@
+{ %norun }
+{$mode delphi}
+unit tb0517;
+
+interface
+
+type
+  tii = interface(iunknown) end;
+  ti2 = interface(iunknown) end;
+
+function a(b: longint): tii; stdcall;
+
+implementation
+
+function a;
+begin
+end;
+
+end.

tests/webtbf/tw0890a.pp

@@ -0,0 +1,44 @@
+{ %fail }
+{$ifdef FPC}
+  {$MODE TP}
+{$endif FPC}
+
+unit tw0890;
+
+INTERFACE
+
+procedure GetScreenLine(const x: Integer);
+
+function dummy(const x : integer) : integer;
+function dummy2(var x : integer) : integer;
+function dummystr(x : integer) : string;
+
+IMPLEMENTATION
+
+
+procedure GetScreenLine;
+begin
+end;
+
+function dummy2;
+begin
+  dummy2:=x;
+  x:=0;
+end;
+
+function dummystr;
+var
+  s : string;
+begin
+  str(x,s);
+  dummystr:=s;
+end;
+
+{ this one is refused by BP :( }
+function dummy : integer;
+begin
+  dummy:=x;
+end;
+
+begin
+end.

tests/webtbs/tw0890.pp

@@ -8,7 +8,6 @@ INTERFACE
 
 procedure GetScreenLine(const x: Integer);
 
-function dummy(const x : integer) : integer;
 function dummy2(var x : integer) : integer;
 function dummystr(x : integer) : string;
 
@@ -33,11 +32,5 @@ begin
   dummystr:=s;
 end;
 
-{ this one is refused by BP :( }
-function dummy : integer;
-begin
-  dummy:=x;
-end;
-
 begin
 end.