+2013-02-13 Tobias Burnus <burnus@net-b.de>
+
+ Backported from mainline
+ 2013-01-07 Tobias Burnus <burnus@net-b.de>
+ Thomas Koenig <tkoenig@gcc.gnu.org>
+ Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/55852
+ * expr.c (gfc_build_intrinsic_call): Avoid clashes
+ with user's procedures.
+ * gfortran.h (gfc_build_intrinsic_call): Update prototype.
+ (GFC_PREFIX): Define.
+ * simplify.c (gfc_simplify_size): Update call.
+
2013-02-03 Thomas Koenig <tkoenig@gcc.gnu.org>
Backport from trunk
want to add arguments but with a NULL-expression. */
gfc_expr*
-gfc_build_intrinsic_call (const char* name, locus where, unsigned numarg, ...)
+gfc_build_intrinsic_call (gfc_namespace *ns, gfc_isym_id id, const char* name,
+ locus where, unsigned numarg, ...)
{
gfc_expr* result;
gfc_actual_arglist* atail;
gfc_intrinsic_sym* isym;
va_list ap;
unsigned i;
+ const char *mangled_name = gfc_get_string (GFC_PREFIX ("%s"), name);
- isym = gfc_find_function (name);
+ isym = gfc_intrinsic_function_by_id (id);
gcc_assert (isym);
result = gfc_get_expr ();
result->expr_type = EXPR_FUNCTION;
result->ts = isym->ts;
result->where = where;
- result->value.function.name = name;
+ result->value.function.name = mangled_name;
result->value.function.isym = isym;
- result->symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ gfc_get_sym_tree (mangled_name, ns, &result->symtree, false);
+ gfc_commit_symbol (result->symtree->n.sym);
gcc_assert (result->symtree
&& (result->symtree->n.sym->attr.flavor == FL_PROCEDURE
|| result->symtree->n.sym->attr.flavor == FL_UNKNOWN));
+ result->symtree->n.sym->intmod_sym_id = id;
+ result->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+ result->symtree->n.sym->attr.intrinsic = 1;
+
va_start (ap, numarg);
atail = NULL;
for (i = 0; i < numarg; ++i)
#define PREFIX(x) "_gfortran_" x
#define PREFIX_LEN 10
+/* A prefix for internal variables, which are not user-visible. */
+#if !defined (NO_DOT_IN_LABEL)
+# define GFC_PREFIX(x) "_F." x
+#elif !defined (NO_DOLLAR_IN_LABEL)
+# define GFC_PREFIX(x) "_F$" x
+#else
+# define GFC_PREFIX(x) "_F_" x
+#endif
+
#define BLANK_COMMON_NAME "__BLNK__"
/* Macro to initialize an mstring structure. */
bool gfc_has_ultimate_allocatable (gfc_expr *);
bool gfc_has_ultimate_pointer (gfc_expr *);
-gfc_expr* gfc_build_intrinsic_call (const char*, locus, unsigned, ...);
+gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
+ locus, unsigned, ...);
gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*);
/* Otherwise, we build a new SIZE call. This is hopefully at least
simpler than the original one. */
if (!simplified)
- simplified = gfc_build_intrinsic_call ("size", array->where, 3,
+ simplified = gfc_build_intrinsic_call (gfc_current_ns,
+ GFC_ISYM_SIZE, "size",
+ array->where, 3,
gfc_copy_expr (replacement),
gfc_copy_expr (dim),
gfc_copy_expr (kind));
+2013-02-13 Tobias Burnus <burnus@net-b.de>
+
+ Backported from mainline
+ 2013-01-07 Tobias Burnus <burnus@net-b.de>
+ Uros Bizjak <ubizjak@gmail.com>
+
+ PR fortran/55852
+ * gfortran.dg/intrinsic_size_3.f90: New.
+
2013-02-11 Uros Bizjak <ubizjak@gmail.com>
Backport from mainline
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/55852
+!
+! Contributed by A. Kasahara
+!
+program bug
+ implicit none
+
+ Real, allocatable:: a(:)
+ integer(2) :: iszs
+
+ allocate(a(1:3))
+
+ iszs = ubound((a), 1)! Was ICEing
+! print*, ubound((a), 1) ! Was ICEing
+! print*, ubound(a, 1) ! OK
+! print*, lbound((a), 1) ! OK
+! print*, lbound(a, 1) ! OK
+
+ stop
+end program bug
+
+! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) MAX_EXPR <\\(D.\[0-9\]+->dim.0..ubound - D.\[0-9\]+->dim.0..lbound\\) \\+ 1, 0>;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }