paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 19:49:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Rika to optimize ArcCos, resolves #40078

Browse Source
This commit is contained in:
florian 2023-01-02 18:55:23 +01:00
parent 9998104048
commit cfbdf90ab0
2 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/objpas/math.pp
View File

@ -1179,37 +1179,19 @@ end;
{$ifdef FPC_HAS_TYPE_SINGLE}
function Arccos(x : Single) : Single;
begin
if abs(x)=1.0 then
if x<0.0 then
arccos:=Pi
else
arccos:=0
else
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
end;
{$ENDIF}
{$ifdef FPC_HAS_TYPE_DOUBLE}
function Arccos(x : Double) : Double;
begin
if abs(x)=1.0 then
if x<0.0 then
arccos:=Pi
else
arccos:=0
else
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
end;
{$ENDIF}
{$ifdef FPC_HAS_TYPE_EXTENDED}
function Arccos(x : Extended) : Extended;
begin
if abs(x)=1.0 then
if x<0.0 then
arccos:=Pi
else
arccos:=0
else
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
end;
{$ENDIF}

20
tests/test/units/math/tsincos.pp
View File

@ -37,6 +37,26 @@ begin
halt(11);
if not(SameValue(e2,-1)) then
halt(12);
{ ArcCos relies on ArcTan2 edge cases. }
s1:=arccos(single(1));
if s1<>0 then
halt(13);
s1:=arccos(single(-1));
if not SameValue(s1,single(pi)) then
halt(14);
d1:=arccos(double(1));
if d1<>0 then
halt(15);
d1:=arccos(double(-1));
if not SameValue(d1,double(pi)) then
halt(16);
e1:=arccos(extended(1));
if e1<>0 then
halt(17);
e1:=arccos(extended(-1));
if not SameValue(e1,extended(pi),1e-12) then
halt(18);
writeln('ok');
end.