+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
}
-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. */
{
gfc_constructor *c;
gfc_actual_arglist *arg;
+ gfc_symbol *sym;
if (e == NULL)
return 1;
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:
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);
void
gfc_intrinsic_init_1 (void)
{
- int i;
-
nargs = nfunc = nsub = nconv = 0;
/* Create a namespace to hold the resolved intrinsic symbols. */
/* 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;
}