* place the function result parameter last for safecall routines on

    all platforms that support a safecall calling convention

git-svn-id: trunk@16114 -

.gitattributes

@@ -9537,6 +9537,9 @@ tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
 tests/test/tsafecall1.pp svneol=native#text/plain
+tests/test/tsafecall2.pp svneol=native#text/pascal
+tests/test/tsafecall3.pp svneol=native#text/pascal
+tests/test/tsafecall4.pp svneol=native#text/pascal
 tests/test/tsealed1.pp svneol=native#text/pascal
 tests/test/tsealed2.pp svneol=native#text/pascal
 tests/test/tsealed3.pp svneol=native#text/pascal

compiler/pdecsub.pas

@@ -105,16 +105,16 @@ implementation
             current_tokenpos:=tprocdef(pd).fileinfo;
 
 {$if defined(i386)}
-           { For left to right add it at the end to be delphi compatible }
+           { For left to right add it at the end to be delphi compatible.
+             In the case of safecalls with safecal-exceptions support the
+             funcret-para is (from the 'c'-point of view) a normal parameter
+             which has to be added to the end of the parameter-list }
            if (pd.proccalloption in (pushleftright_pocalls)) or
-              ((target_info.system in systems_all_windows) and
+              ((tf_safecall_exceptions in target_info.flags) and
                (pd.proccalloption=pocall_safecall)) then
              paranr:=paranr_result_leftright
            else
 {$elseif defined(x86) or defined(arm)}
-           { other platforms don't have a "safecall" convention,
-             and never reverse the parameter pushing order
-           }
            if (target_info.system in systems_all_windows) and
               (pd.proccalloption = pocall_safecall)  then
              paranr:=paranr_result_leftright

tests/test/tsafecall2.pp

@@ -0,0 +1,46 @@
+{ %TARGET=win32,win64,wince}
+program tsafecall2;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+// On Windows, safecall should behave like a stdcall, so it can be used for COM/
+// ActiveX. On Unix systems, it should be cdecl so that it could be used with
+// xpcom.
+
+function SafecallProcedureAlias(AParam1,AParam2: integer):HRESULT; {$IFDEF windows}stdcall{$ELSE}cdecl{$ENDIF}; [external name '_SAFECALLPROCEDURE'];
+procedure SafecallProcedure(AParam1,AParam2: integer); safecall; [public, alias: '_SAFECALLPROCEDURE'];
+begin
+  if (AParam1<>$123456) or (AParam2<>$654321) then
+    halt(1);
+end;
+
+function SafecallFunctionAlias(AParam1,AParam2: integer; out _result: string):HRESULT; {$IFDEF windows}stdcall{$ELSE}cdecl{$ENDIF}; [external name '_SAFECALLFUNCTION'];
+function SafecallFunction(AParam1,AParam2: integer): string; safecall; [public, alias: '_SAFECALLFUNCTION'];
+begin
+  if (AParam1<>$123456) or (AParam2<>$654321) then
+    halt(2)
+  else
+    result := 'hello';
+end;
+
+var s: string;
+
+begin
+  try
+    // The call is in a try..finally block. This is to test if the stack is
+    // cleaned succesfully after the call. Without the try..finally it could
+    // be that the stack is corrupted, but that this does not lead to any
+    // detectable problems (exception)
+    if SafecallProcedureAlias($123456,$654321) <> 0 then
+      halt(11);
+    if SafecallFunctionAlias($123456,$654321,s) <> 0 then
+      halt(12);
+    if s<>'hello' then halt(13);
+  finally
+    writeln('Ok');
+  end;
+end.
+

tests/test/tsafecall3.pp

@@ -0,0 +1,35 @@
+{ %TARGET=win32,win64,wince}
+program tsafecall3;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+function SafecallProcedureAlias(AParam1,AParam2: integer):HRESULT; {$IFDEF windows}stdcall{$ELSE}cdecl{$ENDIF}; [external name '_SAFECALLPROCEDURE'];
+procedure SafecallProcedure(AParam1,AParam2: integer); safecall; [public, alias: '_SAFECALLPROCEDURE'];
+var i,j: double;
+begin
+  i := 1;
+  j := 0;
+  // division by zero, but no exception should be raised. Instead the function
+  // result has to be <> 0
+  i := i/j;
+end;
+
+function SafecallFunctionAlias(AParam1,AParam2: integer; out _result: string):HRESULT; {$IFDEF windows}stdcall{$ELSE}cdecl{$ENDIF}; [external name '_SAFECALLFUNCTION'];
+function SafecallFunction(AParam1,AParam2: integer): string; safecall; [public, alias: '_SAFECALLFUNCTION'];
+begin
+  raise exception.create('Ignore and return non-zero');
+end;
+
+var
+  s : string;
+
+begin
+  if SafecallProcedureAlias($123456,$654321) = 0 then
+    halt(1);
+  if SafecallFunctionAlias($123456,$654321,s) = 0 then
+    halt(2);
+end.
+

tests/test/tsafecall4.pp

@@ -0,0 +1,53 @@
+{ %TARGET=win32,win64,wince}
+program tsafecall4;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+procedure SafecallProcedure(AParam1,AParam2: integer); safecall;
+var i,j: double;
+begin
+  if (AParam1<>$123456) or (AParam2<>$654321) then
+    halt(1);
+  i := 1;
+  j := 0;
+  // division by zero, but no exception should be raised. Instead the function
+  // result has to be <> 0
+  i := i/j;
+end;
+
+function SafecallFunction(AParam1,AParam2: integer): string; safecall;
+begin
+  if (AParam1<>$123456) or (AParam2<>$654321) then
+    halt(2);
+  raise exception.create('Ignore and return non-zero');
+end;
+
+var
+  s : string;
+  pass : boolean;
+
+begin
+  pass := false;
+  try
+    SafecallProcedure($123456,$654321);
+  except
+    on E: ESafecallException do
+      pass := true;
+  end;
+  if not pass then
+    halt(11);
+
+  pass := false;
+  try
+    s := SafecallFunction($123456,$654321);
+  except
+    on E: ESafecallException do
+      pass := true;
+  end;
+  if not pass then
+    halt(12);
+end.
+