OSDN Git Service

2010-11-09 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 10 Nov 2010 04:58:16 +0000 (04:58 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 10 Nov 2010 04:58:16 +0000 (04:58 +0000)
    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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@166520 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/fortran/intrinsic.c

index bfd8303..e2af57f 100644 (file)
@@ -1,3 +1,14 @@
+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
index 2b98b35..a22e660 100644 (file)
@@ -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:
index 8454797..f7f0e05 100644 (file)
@@ -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;
 }