Generate correct fn specs for some Fortran library functions.

This patch works by generating the correct fn spec from the
actual arguments in specific_intrinsic_symbol, and by passing this
down via gfc_get_extern_function_decl to gfc_get_function_type.
CSHIFT remains to be done.

gcc/fortran/ChangeLog:

	PR fortran/97454
	* trans-decl.c (gfc_get_extern_function_decl): Add argument
	fnspec.
	* trans-intrinsic.c (MAX_SPEC_ARG): Define.
	(intrinsic_fnspec): New function.
	(ADD_CHAR): Define.
	(specific_intrinsic_symbol): Adjust comment. Pass
	fn spec to gfc_get_extern_function_decl.
	(gfc_conv_intrinsic_funcall): Add ANY, ALL, NORM2, PRODUCT
	and SUM intrnisic. Add FIXME for cshift et al.
	* trans-types.c	(gfc_get_function_type): Add fnspec argument,
	handle it.
	* trans-types.h (gfc_get_function_type): Add optinal fnspec
	argument.
	* trans.h (gfc_get_extern_function_decl): Likewise.

1 files changed, 75 insertions, 4 deletions

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d17b623..bcc13ce 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -40,6 +40,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-types.h"
 #include "trans-array.h"
 #include "dependency.h"	/* For CAF array alias analysis.  */
+#include "attribs.h"
+
 /* Only for gfc_trans_assign and gfc_trans_pointer_assign.  */
 
 /* This maps Fortran intrinsic math functions to external library or GCC
@@ -4257,10 +4259,69 @@ remove_empty_actual_arguments (gfc_actual_arglist **ap)
     }
 }
 
+#define MAX_SPEC_ARG 12
+
+/* Make up an fn spec that's right for intrinsic functions that we
+   want to call.  */
+
+static char *
+intrinsic_fnspec (gfc_expr *expr)
+{
+  static char fnspec_buf[MAX_SPEC_ARG*2+1];
+  char *fp;
+  int i;
+  int num_char_args;
+
+#define ADD_CHAR(c) do { *fp++ = c; *fp++ = ' '; } while(0)
+
+  /* Set the fndecl.  */
+  fp = fnspec_buf;
+  /* Function return value.  FIXME: Check if the second letter could
+     be something other than a space, for further optimization.  */
+  ADD_CHAR ('.');
+  if (expr->rank == 0)
+    {
+      if (expr->ts.type == BT_CHARACTER)
+	{
+	  ADD_CHAR ('w');  /* Address of character.  */
+	  ADD_CHAR ('.');  /* Length of character.  */
+	}
+    }
+  else
+    ADD_CHAR ('w');  /* Return value is a descriptor.  */
+
+  num_char_args = 0;
+  for (gfc_actual_arglist *a = expr->value.function.actual; a; a = a->next)
+    {
+      if (a->expr == NULL)
+	continue;
+
+      if (a->name && strcmp (a->name,"%VAL") == 0)
+	ADD_CHAR ('.');
+      else
+	{
+	  if (a->expr->rank > 0)
+	    ADD_CHAR ('r');
+	  else
+	    ADD_CHAR ('R');
+	}
+      num_char_args += a->expr->ts.type == BT_CHARACTER;
+      gcc_assert (fp - fnspec_buf + num_char_args <= MAX_SPEC_ARG*2);
+    }
+
+  for (i = 0; i < num_char_args; i++)
+    ADD_CHAR ('.');
+
+  *fp = '\0';
+  return fnspec_buf;
+}
+
+#undef MAX_SPEC_ARG
+#undef ADD_CHAR
+
 /* Generate the right symbol for the specific intrinsic function and
  modify the expr accordingly.  This assumes that absent optional
- arguments should be removed.  FIXME: This should be extended for
- procedures which do not ignore optional arguments (PR 97454).  */
+ arguments should be removed.  */
 
 gfc_symbol *
 specific_intrinsic_symbol (gfc_expr *expr)
@@ -4278,14 +4339,19 @@ specific_intrinsic_symbol (gfc_expr *expr)
       gfc_copy_formal_args_intr (sym, expr->value.function.isym,
 				 expr->value.function.actual, true);
       sym->backend_decl
-	= gfc_get_extern_function_decl (sym, expr->value.function.actual);
+	= gfc_get_extern_function_decl (sym, expr->value.function.actual,
+					intrinsic_fnspec (expr));
     }
+
   remove_empty_actual_arguments (&(expr->value.function.actual));
 
   return sym;
 }
 
-/* Generate a call to an external intrinsic function.  */
+/* Generate a call to an external intrinsic function.  FIXME: So far,
+   this only works for functions which are called with well-defined
+   types; CSHIFT and friends will come later.  */
+
 static void
 gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
 {
@@ -4302,11 +4368,16 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
 
   switch (expr->value.function.isym->id)
     {
+    case GFC_ISYM_ANY:
+    case GFC_ISYM_ALL:
     case GFC_ISYM_FINDLOC:
     case GFC_ISYM_MAXLOC:
     case GFC_ISYM_MINLOC:
     case GFC_ISYM_MAXVAL:
     case GFC_ISYM_MINVAL:
+    case GFC_ISYM_NORM2:
+    case GFC_ISYM_PRODUCT:
+    case GFC_ISYM_SUM:
       specific_symbol = true;
       break;
     default: