This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Fix for fortran/3807 - Function BESJN(integer,double) problems
- From: "Billinghurst, David (CRTS)" <David dot Billinghurst at riotinto dot com>
- To: <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 11 Jan 2002 21:11:32 +0800
- Subject: Fix for fortran/3807 - Function BESJN(integer,double) problems
While working on tests for Bessel functions, I found some problems with
intrinsic functions BESJN and BESYN. I am not sure it they are bugs or
documentation issues.
g77 is upset about the return type of BESJN(i,x) for double precision x.
The documentation indicates that the return type is that of the second
argument d.
The source, in intrin.def agrees, with
DEFIMP (BESJN,"BESJN",L_BESJN,,,"R=:1:N=I*,X=R*")
The problem lies in f/intrin.c. The code around line 620 does not
handle the case when the return type is specified by the second argument
":1:". The only cases handled are:
- ":-:" explicit return type
- ":*:" return type depends on all args
or it defaults to the first argument
This patch fixes most of the cases, but the cases where the first
argument is integer*8 still fail. I think I have convinced myself this
is a different bug.
Tested on i686-pc-cygwin
2001-01-12 David Billinghurst <David.Billinghurst@riotinto.com>
PR fortran/3807
* f/intrin.c (ffeintrin_check_): Allow for case of intrinsic
control string have COL-spec an integer > 0
testsuite/g77.f-torture/execute/intrinsic-unix-bessel.f:
Uncomment additional cases that now pass
Index: f/intrin.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/intrin.c,v
retrieving revision 1.20
diff -u -p -r1.20 intrin.c
--- intrin.c 2001/10/21 21:32:07 1.20
+++ intrin.c 2002/01/11 13:07:00
@@ -622,10 +622,11 @@ ffeintrin_check_ (ffeintrinImp imp, ffeb
{
bool okay = TRUE;
bool have_anynum = FALSE;
+ int arg_count=0;
- for (arg = args;
+ for (arg = args, arg_count=0;
arg != NULL;
- arg = (c[colon + 1] == '*') ? ffebld_trail (arg) : NULL)
+ arg = ffebld_trail (arg), arg_count++ )
{
ffebld a = ffebld_head (arg);
ffeinfo i;
@@ -635,6 +636,9 @@ ffeintrin_check_ (ffeintrinImp imp, ffeb
continue;
i = ffebld_info (a);
+ if ( c[colon+1] != '*' && (c[colon+1]-'0') != arg_count )
+ continue;
+
anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
if (anynum)
Index: testsuite/g77.f-torture/execute/intrinsic-unix-bessel.f
===================================================================
RCS file:
/cvs/gcc/gcc/gcc/testsuite/g77.f-torture/execute/intrinsic-unix-besse.f,
v
retrieving revision 1.1
diff -u -p -r1.1 intrinsic-unix-bessel.f
--- intrinsic-unix-bessel.f 2001/07/24 13:32:53 1.1
+++ intrinsic-unix-bessel.f 2002/01/11 13:07:01
@@ -39,11 +39,11 @@ c BESJN - Bessel function of first
a = 0.3528340
da = a
call c_r(BESJN(i,x),a,'BESJN(integer,real)')
-c call c_r(BESJN(j,x),a,'BESJN(integer*2,real)')
-c call c_r(BESJN(k,x),a,'BESJN(integer*1,real)')
+ call c_r(BESJN(j,x),a,'BESJN(integer*2,real)')
+ call c_r(BESJN(k,x),a,'BESJN(integer*1,real)')
c call c_r(BESJN(m,x),a,'BESJN(integer*8,real)')
-c call c_d(BESJN(i,dx),da,'BESJN(integer,double)')
-c call c_d(BESJN(j,dx),da,'BESJN(integer*2,double)')
+ call c_d(BESJN(i,dx),da,'BESJN(integer,double)')
+ call c_d(BESJN(j,dx),da,'BESJN(integer*2,double)')
call c_d(BESJN(k,dx),da,'BESJN(integer*1,double)')
c call c_d(BESJN(m,dx),da,'BESJN(integer*8,double)')
call c_d(DBESJN(i,dx),da,'DBESJN(integer,double)')
@@ -69,11 +69,11 @@ c BESYN - Bessel function of second
a = -0.6174081
da = a
call c_r(BESYN(i,x),a,'BESYN(integer,real)')
-c call c_r(BESYN(j,x),a,'BESYN(integer*2,real)')
-c call c_r(BESYN(k,x),a,'BESYN(integer*1,real)')
+ call c_r(BESYN(j,x),a,'BESYN(integer*2,real)')
+ call c_r(BESYN(k,x),a,'BESYN(integer*1,real)')
c call c_r(BESYN(m,x),a,'BESYN(integer*8,real)')
-c call c_d(BESYN(i,dx),da,'BESYN(integer,double)')
-c call c_d(BESYN(j,dx),da,'BESYN(integer*2,double)')
+ call c_d(BESYN(i,dx),da,'BESYN(integer,double)')
+ call c_d(BESYN(j,dx),da,'BESYN(integer*2,double)')
call c_d(BESYN(k,dx),da,'BESYN(integer*1,double)')
c call c_d(BESYN(m,dx),da,'BESYN(integer*8,double)')
call c_d(DBESYN(i,dx),da,'DBESYN(integer,double)')