public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression
@ 2016-11-09 12:47 Paul Richard Thomas
  2016-11-09 15:04 ` Dominique d'Humières
  0 siblings, 1 reply; 11+ messages in thread
From: Paul Richard Thomas @ 2016-11-09 12:47 UTC (permalink / raw)
  To: fortran, gcc-patches; +Cc: Dominique Dhumieres, Ian Harvey

[-- Attachment #1: Type: text/plain, Size: 1960 bytes --]

Dear All,

The title of this PR says what this is all about, except that it
applies uniquely applicable to character function result string
lengths.

Ian Harvey wrote the first patch for this PR for which many thanks.
However, two issues came up that took some little while to understand;
(i) In comment #1, it was found that calls from sibling procedures
could generate streams of undefined references at the link stage; and
(ii) An entity of the same name as the contained procedure entity in
module scope caused similar problems.

The relationship with Ian's patch is still obvious. The fundamental
difference is that the parameter arrays are automatically promoted to
module scope using a unique symtree. This fixes both the issues above.

Dominique, could you please check that the -m32 issue has gone away?

Bootstrapped and regtested on FC21/x86_64 - OK for trunk?

Paul

2016-11-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/44265
    * gfortran.h : Add fn_result_spec bitfield to gfc_symbol.
    * resolve.c (flag_fn_result_spec): New function.
    (resolve_fntype): Call it for character result lengths.
    * symbol.c (gfc_new_symbol): Set fn_result_spec to zero.
    * trans-decl.c (gfc_sym_mangled_identifier): Include the
    procedure name in the mangled name for symbols with the
    fn_result_spec bit set.
    (gfc_get_symbol_decl): Mangle the name of these symbols.
    (gfc_create_module_variable): Allow them through the assert.
    (gfc_generate_function_code): Remove the assert before the
    initialization of sym->tlink because the frontend no longer
    uses this field.
    * trans-expr.c (gfc_map_intrinsic_function): Add a case to
    treat the LEN_TRIM intrinsic.

2016-11-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/44265
    * gfortran.dg/char_result_14.f90: New test.
    * gfortran.dg/char_result_15.f90: New test.


-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 11843 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 241994)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct gfc_symbol
*** 1498,1503 ****
--- 1498,1505 ----
    unsigned equiv_built:1;
    /* Set if this variable is used as an index name in a FORALL.  */
    unsigned forall_index:1;
+   /* Set if the symbol is used in a function result specification .  */
+   unsigned fn_result_spec:1;
    /* Used to avoid multiple resolutions of a single symbol.  */
    unsigned resolved:1;
    /* Set if this is a module function or subroutine with the
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 241994)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_equivalence (gfc_equiv *eq)
*** 15732,15737 ****
--- 15732,15776 ----
  }
  
  
+ /* Function called by resolve_fntype to flag other symbol used in the
+    length type parameter specification of function resuls.  */
+ 
+ static bool
+ flag_fn_result_spec (gfc_expr *expr,
+                      gfc_symbol *sym ATTRIBUTE_UNUSED,
+                      int *f ATTRIBUTE_UNUSED)
+ {
+   gfc_namespace *ns;
+   gfc_symbol *s;
+ 
+   if (expr->expr_type == EXPR_VARIABLE)
+     {
+       s = expr->symtree->n.sym;
+       for (ns = s->ns; ns; ns = ns->parent)
+ 	if (!ns->parent)
+ 	  break;
+ 
+       if (!s->fn_result_spec && s->ns->parent != NULL
+ 	  && s->attr.flavor == FL_PARAMETER)
+ 	{
+ 	  if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE)
+ 	    {
+ 	      gfc_symtree *st;
+ 	      s->fn_result_spec = 1;
+ 	      /* Make sure that this symbol is translated as a module
+ 		 variable.  */
+ 	      st = gfc_get_unique_symtree (ns);
+ 	      st->n.sym = s;
+ 	      s->refs++;
+ 	    }
+ 	  else if (s->attr.use_assoc || s->attr.used_in_submodule)
+ 	    s->fn_result_spec = 1;
+ 	}
+     }
+   return false;
+ }
+ 
+ 
  /* Resolve function and ENTRY types, issue diagnostics if needed.  */
  
  static void
*************** resolve_fntype (gfc_namespace *ns)
*** 15782,15787 ****
--- 15821,15829 ----
  	    el->sym->attr.untyped = 1;
  	  }
        }
+ 
+   if (sym->ts.type == BT_CHARACTER)
+     gfc_traverse_expr (sym->ts.u.cl->length, NULL, flag_fn_result_spec, 0);
  }
  
  
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 241994)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_new_symbol (const char *name, gfc_na
*** 2933,2938 ****
--- 2933,2939 ----
    p->common_block = NULL;
    p->f2k_derived = NULL;
    p->assoc = NULL;
+   p->fn_result_spec = 0;
    
    return p;
  }
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 241994)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_sym_mangled_identifier (gfc_symbol *
*** 355,361 ****
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return get_identifier (sym->binding_label);
  
!   if (sym->module == NULL)
      return gfc_sym_identifier (sym);
    else
      {
--- 355,372 ----
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return get_identifier (sym->binding_label);
  
!   if (sym->fn_result_spec)
!     {
!       /* This is an entity that is actually local to a module procedure
! 	 that appears in the result specification expression.  Since
! 	 sym->module will be a zero length string, we use ns->proc_name
! 	 instead. */
!       snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
! 		sym->ns->proc_name->module, sym->ns->proc_name->name,
! 		sym->name);
!       return get_identifier (name);
!     }
!   else if (sym->module == NULL)
      return gfc_sym_identifier (sym);
    else
      {
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1628,1634 ****
    /* Create string length decl first so that they can be used in the
       type declaration.  For associate names, the target character
       length is used. Set 'length' to a constant so that if the
!      string lenght is a variable, it is not finished a second time.  */
    if (sym->ts.type == BT_CHARACTER)
      {
        if (sym->attr.associate_var
--- 1639,1645 ----
    /* Create string length decl first so that they can be used in the
       type declaration.  For associate names, the target character
       length is used. Set 'length' to a constant so that if the
!      string length is a variable, it is not finished a second time.  */
    if (sym->ts.type == BT_CHARACTER)
      {
        if (sym->attr.associate_var
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1650,1656 ****
    /* Symbols from modules should have their assembler names mangled.
       This is done here rather than in gfc_finish_var_decl because it
       is different for string length variables.  */
!   if (sym->module)
      {
        gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
        if (sym->attr.use_assoc && !intrinsic_array_parameter)
--- 1661,1667 ----
    /* Symbols from modules should have their assembler names mangled.
       This is done here rather than in gfc_finish_var_decl because it
       is different for string length variables.  */
!   if (sym->module || sym->fn_result_spec)
      {
        gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
        if (sym->attr.use_assoc && !intrinsic_array_parameter)
*************** gfc_create_module_variable (gfc_symbol *
*** 4753,4759 ****
  
    /* Create the variable.  */
    pushdecl (decl);
!   gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
    DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
    rest_of_decl_compilation (decl, 1, 0);
    gfc_module_add_decl (cur_module, decl);
--- 4764,4772 ----
  
    /* Create the variable.  */
    pushdecl (decl);
!   gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE
! 	      || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE
! 		  && sym->fn_result_spec));
    DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
    rest_of_decl_compilation (decl, 1, 0);
    gfc_module_add_decl (cur_module, decl);
*************** gfc_generate_function_code (gfc_namespac
*** 6140,6147 ****
    previous_procedure_symbol = current_procedure_symbol;
    current_procedure_symbol = sym;
  
!   /* Check that the frontend isn't still using this.  */
!   gcc_assert (sym->tlink == NULL);
    sym->tlink = sym;
  
    /* Create the declaration for functions with global scope.  */
--- 6153,6160 ----
    previous_procedure_symbol = current_procedure_symbol;
    current_procedure_symbol = sym;
  
!   /* Initialize sym->tlink so that gfc_trans_deferred_vars does not get
!      lost or worse.  */
    sym->tlink = sym;
  
    /* Create the declaration for functions with global scope.  */
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 241994)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_map_intrinsic_function (gfc_expr *ex
*** 4116,4121 ****
--- 4116,4131 ----
        new_expr = gfc_copy_expr (arg1->ts.u.cl->length);
        break;
  
+     case GFC_ISYM_LEN_TRIM:
+       new_expr = gfc_copy_expr (arg1);
+       gfc_apply_interface_mapping_to_expr (mapping, new_expr);
+ 
+       if (!new_expr)
+ 	return false;
+ 
+       gfc_replace_expr (arg1, new_expr);
+       return true;
+ 
      case GFC_ISYM_SIZE:
        if (!sym->as || sym->as->rank == 0)
  	return false;
Index: gcc/testsuite/gfortran.dg/char_result_14.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_14.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/char_result_14.f90	(working copy)
***************
*** 0 ****
--- 1,78 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR44265. This is the original test with the addition
+ ! of the check of the issue found in comment #1 of the PR.
+ !
+ ! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
+ ! Ian also contributed the first version of the fix.
+ !
+ MODULE Fruits
+   IMPLICIT NONE
+   PRIVATE
+     character (20) :: buffer
+     CHARACTER(*), PARAMETER :: names(4) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ',  &
+         'Pear   ' ];
+   PUBLIC :: Get, SGet, fruity2, fruity3, buffer
+ CONTAINS
+ ! This worked previously
+   subroutine fruity3
+     write (buffer, '(i2,a)') len (Get (4)), Get (4)
+   end
+ ! Original function in the PR
+   FUNCTION Get(i) RESULT(s)
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_trim(names(i))) :: s
+     !****
+     s = names(i)
+   END FUNCTION Get
+ ! Check that dummy is OK
+   Subroutine Sget(i, s)
+     CHARACTER(*), PARAMETER :: names(4) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ',  &
+         'Pear   ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_trim(names(i))), intent(out) :: s
+     !****
+     s = names(i)
+     write (buffer, '(i2,a)') len (s), s
+   END subroutine SGet
+ ! This would fail with undefined references to mangled 'names' during linking
+   subroutine fruity2
+     write (buffer, '(i2,a)') len (Get (3)), Get (3)
+   end
+ END MODULE Fruits
+ 
+ PROGRAM WheresThatbLinkingConstantGone
+   USE Fruits
+   IMPLICIT NONE
+   character(7) :: arg = ""
+   integer :: i
+   !****
+   call fruity
+   if (trim (buffer) .ne. " 6Orange") call abort
+   call fruity2
+   if (trim (buffer) .ne. " 5Mango") call abort
+   call fruity3
+   if (trim (buffer) .ne. " 4Pear") call abort
+   do i = 3, 4
+     call Sget (i, arg)
+     if (i == 3) then
+       if (trim (buffer) .ne. " 5Mango") call abort
+       if (trim (arg) .ne. "Mango") call abort
+     else
+       if (trim (buffer) .ne. " 4Pear") call abort
+ ! Since arg is fixed length in this scope, it gets over-written
+ ! by s, which in this case is length 4. Thus, the 'o' remains.
+       if (trim (arg) .ne. "Pearo") call abort
+     end if
+   enddo
+ contains
+   subroutine fruity
+       write (buffer, '(i2,a)') len (Get (2)), Get (2)
+   end
+ END PROGRAM WheresThatbLinkingConstantGone
Index: gcc/testsuite/gfortran.dg/char_result_15.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_15.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/char_result_15.f90	(working copy)
***************
*** 0 ****
--- 1,44 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR44265. This test arose because of an issue found
+ ! during the development of the fix; namely the clash between the normal
+ ! module parameter and that found in the specification expression for
+ ! 'Get'.
+ !
+ ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+ !
+ MODULE Fruits
+   IMPLICIT NONE
+   PRIVATE
+   character (20) :: buffer
+   PUBLIC :: Get, names, fruity, buffer
+     CHARACTER(len=7), PARAMETER :: names(3) = [  &
+         'Pomme  ',  &
+         'Orange ',  &
+         'Mangue ' ];
+ CONTAINS
+   FUNCTION Get(i) RESULT(s)
+     CHARACTER(len=7), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     s = names(i)
+   END FUNCTION Get
+   subroutine fruity (i)
+     integer :: i
+   write (buffer, '(i2,a)') len (Get (i)), Get (i)
+   end subroutine
+ END MODULE Fruits
+ 
+ PROGRAM WheresThatbLinkingConstantGone
+   USE Fruits
+   IMPLICIT NONE
+   integer :: i
+   write (buffer, '(i2,a)') len (Get (1)), Get (1)
+   if (trim (buffer) .ne. " 5Apple") call abort
+   call fruity(3)
+   if (trim (buffer) .ne. " 5Mango") call abort
+   if (trim (names(3)) .ne. "Mangue") Call abort
+ END PROGRAM WheresThatbLinkingConstantGone

^ permalink raw reply	[flat|nested] 11+ messages in thread
end of thread, other threads:[~2016-12-09 12:11 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-11-09 12:47 [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression Paul Richard Thomas
2016-11-09 15:04 ` Dominique d'Humières
     [not found]   ` <CAGkQGiJrm2r0uRpe9eLBn+yQrC0zfy+oxoriy0GDPU07GJ=iug@mail.gmail.com>
2016-11-09 21:06     ` Dominique d'Humières
2016-11-10 14:50       ` Paul Richard Thomas
2016-11-10 22:49         ` Dominique d'Humières
2016-12-07 12:22           ` Dominique d'Humières
2016-12-07 15:47             ` Paul Richard Thomas
2016-12-07 19:11               ` Dominique d'Humières
2016-12-07 21:44                 ` Paul Richard Thomas
2016-12-07 21:51                   ` Andre Vehreschild
2016-12-09 12:11                     ` Paul Richard Thomas

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).