http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55852



--- Comment #6 from Thomas Koenig <tkoenig at gcc dot gnu.org> 2013-01-06 
21:59:13 UTC ---

This patch works (not regression-tested yet), but the method

using the state variable seems hackish and error-prone.



What do you think?



Index: expr.c

===================================================================

--- expr.c      (Revision 194850)

+++ expr.c      (Arbeitskopie)

@@ -4623,7 +4623,8 @@

    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 (const char* name, const char *symtree_name,

+                         locus where, unsigned numarg, ...)

 {

   gfc_expr* result;

   gfc_actual_arglist* atail;

@@ -4641,11 +4642,17 @@

   result->value.function.name = name;

   result->value.function.isym = isym;



-  result->symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);

-  gcc_assert (result->symtree

-             && (result->symtree->n.sym->attr.flavor == FL_PROCEDURE

-                 || result->symtree->n.sym->attr.flavor == FL_UNKNOWN));

+  if (symtree_name == NULL)

+    {

+      result->symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);



+      gcc_assert (result->symtree &&

+                 (result->symtree->n.sym->attr.flavor == FL_PROCEDURE

+                  || result->symtree->n.sym->attr.flavor == FL_UNKNOWN));

+    }

+  else

+    gfc_get_sym_tree (symtree_name, gfc_current_ns, &result->symtree, true);

+

   va_start (ap, numarg);

   atail = NULL;

   for (i = 0; i < numarg; ++i)

Index: simplify.c

===================================================================

--- simplify.c  (Revision 194850)

+++ simplify.c  (Arbeitskopie)

@@ -33,6 +33,7 @@



 gfc_expr gfc_bad_expr;



+bool artificial_call = false;



 /* Note that 'simplification' is not just transforming expressions.

    For functions that are not simplified at compile time, range

@@ -3248,7 +3249,10 @@

          gfc_expr* dim = result;

          mpz_set_si (dim->value.integer, d);



+         artificial_call = true;

          result = gfc_simplify_size (array, dim, kind);

+         artificial_call = false;

+

          gfc_free_expr (dim);

          if (!result)

            goto returnNull;

@@ -5512,7 +5516,10 @@

        {

          mpz_set_ui (e->value.integer, n + 1);



+         artificial_call = true;

          f = gfc_simplify_size (source, e, NULL);

+         artificial_call = false;

+

          gfc_free_expr (e);

          if (f == NULL)

            {

@@ -5584,11 +5591,18 @@

       /* 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,

-                                              gfc_copy_expr (replacement),

-                                              gfc_copy_expr (dim),

-                                              gfc_copy_expr (kind));

+       {

+         const char *symtree_name;

+         if (artificial_call)

+           symtree_name = "__internal_size";

+         else

+           symtree_name = NULL;



+         simplified = gfc_build_intrinsic_call ("size", symtree_name,

array->where, 3,

+                                                gfc_copy_expr (replacement),

+                                                gfc_copy_expr (dim),

+                                                gfc_copy_expr (kind));

+       }

       return simplified;

     }



Index: gfortran.h

===================================================================

--- gfortran.h  (Revision 194850)

+++ gfortran.h  (Arbeitskopie)

@@ -2797,7 +2797,8 @@

 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 (const char*, const char *, locus,

+                                   unsigned, ...);

 gfc_try gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);

Reply via email to