* implements getter must used target's default calling convention, because

it's called indirectly via an RTL helper that expects this (mantis #15303)

git-svn-id: trunk@14397 -

.gitattributes

@@ -9495,6 +9495,7 @@ tests/webtbf/tw14929b.pp svneol=native#text/plain
 tests/webtbf/tw14946.pp svneol=native#text/plain
 tests/webtbf/tw15287.pp svneol=native#text/plain
 tests/webtbf/tw15288.pp svneol=native#text/plain
+tests/webtbf/tw15303.pp svneol=native#text/plain
 tests/webtbf/tw1599.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain
 tests/webtbf/tw1633.pp svneol=native#text/plain

compiler/msg/errore.msg

@@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
 #
 # Parser
 #
-# 03280 is the last used one
+# 03281 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1273,6 +1273,10 @@ parser_h_should_use_reintroduce_objc=03280_H_Replaced methods can only be reintr
 % called or referred to. This behaviour corresponds somewhat more closely to
 % \var{reintroduce} than to \var{override} (although in case of \var{reintroduce}
 % in Object Pascal, hidden methods are still reachable via inherited).
+parser_e_implements_getter_not_default_cc=03281_E_Getter for implements interface must use the target's default calling convention.
+% Interface getters are called via a helper in the run time library, and hence
+% have to use the default calling convention for the target (\var{register} on
+% i386 and x86_64, \var{stdcall} on other architectures).
 % \end{description}
 #
 # Type Checking

compiler/msgidx.inc

@@ -368,6 +368,7 @@ const
   parser_e_no_category_override=03278;
   parser_e_must_use_reintroduce_objc=03279;
   parser_h_should_use_reintroduce_objc=03280;
+  parser_e_implements_getter_not_default_cc=03281;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -834,9 +835,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 54741;
+  MsgTxtSize = 54831;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,87,281,95,71,51,110,22,202,62,
+    24,87,282,95,71,51,110,22,202,62,
     48,20,1,1,1,1,1,1,1,1
   );

compiler/pdecvar.pas

@@ -719,6 +719,9 @@ implementation
                  message(parser_e_implements_must_read_specifier);
                  exit;
                end;
+             if assigned(p.propaccesslist[palt_read].procdef) and
+                (tprocdef(p.propaccesslist[palt_read].procdef).proccalloption<>pocall_default) then
+               message(parser_e_implements_getter_not_default_cc);
              if assigned(p.propaccesslist[palt_write].firstsym) then
                begin
                  message(parser_e_implements_must_not_have_write_specifier);

tests/webtbf/tw15303.pp

@@ -0,0 +1,44 @@
+{ %fail }
+
+program project1;
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+type
+  IIntf1 = interface['{484A7AC5-114E-4D99-9E4F-7B4906413B2F}'] end;
+
+  IIntf2 = interface['{3718A1FC-A6F6-4465-965D-14FF1CBA1902}']
+    procedure Print2;
+  end;
+
+  TClass2 = class(TInterfacedObject, IIntf2)
+    procedure Print2;
+  end;
+
+  TClass1 = class(TInterfacedObject, IIntf1, IIntf2)
+    private
+      FIntf2:IIntf2;
+      function GetIntf2:IIntf2;stdcall; // <--- should be forbidden
+    public
+      constructor Create;
+      property I:IIntf2 read GetIntf2 implements IIntf2;
+  end;
+
+
+procedure TClass2.Print2;
+begin
+  Writeln('doing something');
+end;
+
+function TClass1.GetIntf2: IIntf2;stdcall;
+begin
+  Result:=FIntf2;
+end;
+
+constructor TClass1.Create;
+begin
+  inherited Create;
+  FIntf2:=TClass2.Create;
+end;
+
+begin
+end.