]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
backport: re PR fortran/55852 (internal compiler error: in gfc_build_intrinsic_call...
authorTobias Burnus <burnus@net-b.de>
Wed, 13 Feb 2013 17:51:11 +0000 (18:51 +0100)
committerTobias Burnus <burnus@gcc.gnu.org>
Wed, 13 Feb 2013 17:51:11 +0000 (18:51 +0100)
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-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.

From-SVN: r196020

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/fortran/gfortran.h
gcc/fortran/simplify.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 [new file with mode: 0644]

index 52595e6db56b8b5db8dd46436afc5d7c445bbaec..d1d42ff07dda2cbb597ca6fc044352d86a408244 100644 (file)
@@ -1,3 +1,17 @@
+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
index 3330cc89313427a0b004fc10aa46450a6250222c..8fa542e807926943e240f18f0211ff15876000bc 100644 (file)
@@ -4345,29 +4345,36 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
    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)
index 6199d8970655874861edb431145114d6f8148fc6..0c96a8224f737cdf9fd5ebe34f110754248d632e 100644 (file)
@@ -63,6 +63,15 @@ along with GCC; see the file COPYING3.  If not see
 #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.  */
@@ -2733,7 +2742,8 @@ int gfc_get_corank (gfc_expr *);
 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*);
 
 
index 5fe5d1db1a0ff72add7dd57b5f16d1d92b69758b..4257fc754ba01934b2879bf08c2e2006cfd6df02 100644 (file)
@@ -5615,7 +5615,9 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
       /* 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));
index bc5036222335722362801b09689f5abfc8f9525e..2a43fe081600cccc32732cc602ddfc5dad063c52 100644 (file)
@@ -1,3 +1,12 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
new file mode 100644 (file)
index 0000000..5856509
--- /dev/null
@@ -0,0 +1,26 @@
+! { 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" } }