This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

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)')


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]