re PR fortran/3807 (Function BESJN(integer,double) problems)

2001-01-14  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.

From-SVN: r48854

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index c151a1f404ac54a16160b3faa33ee6fb4b4ad6e2..b3a9d4acb322bf9983a935263eca9c941c3174f5 100644 (file)
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,9 @@
+2001-01-14  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.
+
 2002-01-08  Joseph S. Myers  <jsm28@cam.ac.uk>
 
        * g77spec.c (lookup_option): Handle -fversion.

diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
index 393706aa3318d41d21b9ea0b7b196d05d040dd39..99d849b72713762e7d1b915a0767003a7cdaf7f8 100644 (file)
--- a/gcc/f/intrin.c
+++ b/gcc/f/intrin.c
@@ -1,5 +1,5 @@
 /* intrin.c -- Recognize references to intrinsics
-   Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+   Copyright (C) 1995, 1996, 1997, 1998, 2002 Free Software Foundation, Inc.
    Contributed by James Craig Burley.
 
 This file is part of GNU Fortran.
@@ -622,10 +622,11 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
     {
       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, ffebldOp op,
            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)