re PR fortran/46331 (Compilation time long with simple function in array constructor)

2010-11-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Mikael Morin   <mikael@gcc.gnu.org>

	PR fortran/46331
	* intrinsic.c: Correctly set the pure attributes for intrinsic
	functions.
	* expr.c (check_specification_function): Remove this function and move
	its code into gfc_is_constant_expr. (gfc_is_constant_expr): Change the
	order of checks by checking for non-constant arguments first.  Then,
	check for initialization functions, followed by intrinsics.

Co-Authored-By: Mikael Morin <mikael@gcc.gnu.org>

From-SVN: r166520

gcc/fortran/ChangeLog

+2010-11-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Mikael Morin   <mikael@gcc.gnu.org>
+
+	PR fortran/46331
+	* intrinsic.c: Correctly set the pure attributes for intrinsic
+	functions.
+	* expr.c (check_specification_function): Remove this function and move
+	its code into gfc_is_constant_expr. (gfc_is_constant_expr): Change the
+	order of checks by checking for non-constant arguments first.  Then,
+	check for initialization functions, followed by intrinsics.
+
 2010-11-09  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/46313

gcc/fortran/expr.c

@@ -868,31 +868,6 @@ done:
 }
 
 
-static match
-check_specification_function (gfc_expr *e)
-{
-  gfc_symbol *sym;
-
-  if (!e->symtree)
-    return MATCH_NO;
-
-  sym = e->symtree->n.sym;
-
-  /* F95, 7.1.6.2; F2003, 7.1.7  */
-  if (sym
-      && sym->attr.function
-      && sym->attr.pure
-      && !sym->attr.intrinsic
-      && !sym->attr.recursive
-      && sym->attr.proc != PROC_INTERNAL
-      && sym->attr.proc != PROC_ST_FUNCTION
-      && sym->attr.proc != PROC_UNKNOWN
-      && sym->formal == NULL)
-    return MATCH_YES;
-
-  return MATCH_NO;
-}
-
 /* Function to determine if an expression is constant or not.  This
    function expects that the expression has already been simplified.  */
 
@@ -901,6 +876,7 @@ gfc_is_constant_expr (gfc_expr *e)
 {
   gfc_constructor *c;
   gfc_actual_arglist *arg;
+  gfc_symbol *sym;
 
   if (e == NULL)
     return 1;
@@ -918,21 +894,40 @@ gfc_is_constant_expr (gfc_expr *e)
     case EXPR_FUNCTION:
     case EXPR_PPC:
     case EXPR_COMPCALL:
-      /* Specification functions are constant.  */
-      if (check_specification_function (e) == MATCH_YES)
-	return 1;
-
       /* Call to intrinsic with at least one argument.  */
       if (e->value.function.isym && e->value.function.actual)
 	{
 	  for (arg = e->value.function.actual; arg; arg = arg->next)
 	    if (!gfc_is_constant_expr (arg->expr))
 	      return 0;
-
-	  return 1;
 	}
-      else
-	return 0;
+
+      /* Make sure we have a symbol.  */
+      gcc_assert (e->symtree);
+
+      sym = e->symtree->n.sym;
+    
+      /* Specification functions are constant.  */
+      /* F95, 7.1.6.2; F2003, 7.1.7  */
+      if (sym
+	  && sym->attr.function
+	  && sym->attr.pure
+	  && !sym->attr.intrinsic
+	  && !sym->attr.recursive
+	  && sym->attr.proc != PROC_INTERNAL
+	  && sym->attr.proc != PROC_ST_FUNCTION
+	  && sym->attr.proc != PROC_UNKNOWN
+	  && sym->formal == NULL)
+	return 1;
+
+      if (e->value.function.isym
+	  && (e->value.function.isym->elemental
+	      || e->value.function.isym->pure
+	      || e->value.function.isym->inquiry
+	      || e->value.function.isym->transformational))
+	return 1;
+
+      return 0;
 
     case EXPR_CONSTANT:
     case EXPR_NULL:

gcc/fortran/intrinsic.c

@@ -274,10 +274,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
       strcat (buf, name);
       next_sym->lib_name = gfc_get_string (buf);
 
-      /* There are no IMPURE ELEMENTAL intrinsics, thus the ELEMENTAL class
-	 also implies PURE.  Additionally, there's the PURE class itself.  */
-      next_sym->pure = (cl == CLASS_ELEMENTAL || cl == CLASS_PURE);
-
+      next_sym->pure = (cl != CLASS_IMPURE);
       next_sym->elemental = (cl == CLASS_ELEMENTAL);
       next_sym->inquiry = (cl == CLASS_INQUIRY);
       next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
@@ -3370,8 +3367,6 @@ add_char_conversions (void)
 void
 gfc_intrinsic_init_1 (void)
 {
-  int i;
-
   nargs = nfunc = nsub = nconv = 0;
 
   /* Create a namespace to hold the resolved intrinsic symbols.  */
@@ -3404,15 +3399,6 @@ gfc_intrinsic_init_1 (void)
 
   /* Character conversion intrinsics need to be treated separately.  */
   add_char_conversions ();
-
-  /* Set the pure flag.  All intrinsic functions are pure, and
-     intrinsic subroutines are pure if they are elemental.  */
-
-  for (i = 0; i < nfunc; i++)
-    functions[i].pure = 1;
-
-  for (i = 0; i < nsub; i++)
-    subroutines[i].pure = subroutines[i].elemental;
 }