[Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Paul Richard Thomas]

[-- 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

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Dominique d'Humières]

Sorry for the bad news, but while gfortran regtests with regression with the patch I still get a link error with the original test:

% gfc pr44265.f90
Undefined symbols for architecture x86_64:
  "___fruits_MOD_names", referenced from:
      _MAIN__ in ccyeNqa1.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status

and its variants.

Thanks for working on this issue

Dominique

> Le 9 nov. 2016 à 13:47, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> 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
> <submit.diff>

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Dominique d'Humières]

> Le 9 nov. 2016 à 20:09, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Dear Dominique,
> 
> I am deeply embarrassed. This is the consequence of an additional
> condition added at the last minute.

No reason to be embarrassed;-)

> The attached removes it and makes sure that the original bug is tested
> in char_result_14.f90. The ChangeLogs are the same.
> 
> OK for trunk?

IMO yes

> 
> Paul
> 

I have a last glitch (which can be deferred if needed):

  FUNCTION Get(i) RESULT(s)    
    CHARACTER(*), PARAMETER :: names(3) = [  &
        'Apple  ',  &
        'Orange ',  &
        'Mango  ' ];              
    INTEGER, INTENT(IN) :: i
    CHARACTER(LEN_TRIM(names(i))) :: s    
    !****    
    s = names(i)    
    print *, len(s)
  END FUNCTION Get

PROGRAM WheresThatbLinkingConstantGone
  IMPLICIT NONE
  interface
    FUNCTION Get(i) RESULT(s)
      CHARACTER(*), PARAMETER :: names(3) = [  &
                  'Apple  ',  &
                  'Orange ',  &
                  'Mango  ' ];
      INTEGER, INTENT(IN) :: i
      CHARACTER(LEN_TRIM(names(i))) :: s
  END FUNCTION Get
  end interface

  integer :: i
  i = len(Get(1))
  print *, i
END PROGRAM WheresThatbLinkingConstantGone

does not link.

Dominique

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Paul Richard Thomas]

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

Hi Dominique.

....snip....
> I have a last glitch (which can be deferred if needed):
....snip....

Fixed by the new patch, which is attached. Bootstraps and regtests OK.

OK for trunk?

Paul

2016-11-10  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-10  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.
    * gfortran.dg/char_result_16.f90: New test.


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

Albert Einstein

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 14442 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,15785 ----
  }
  
  
+ /* 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->attr.flavor == FL_PARAMETER)
+ 	{
+ 	  /* Function contained in a module.... */
+ 	  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++;
+ 	    }
+ 	  /* ... which is use associated and called.  */
+ 	  else if (s->attr.use_assoc || s->attr.used_in_submodule
+ 			||
+ 		  /* External function matched with an interface.  */
+ 		  (s->ns->proc_name
+ 		   && ((s->ns == ns
+ 			 && s->ns->proc_name->attr.if_source == IFSRC_DECL)
+ 		       || s->ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ 		   && s->ns->proc_name->attr.function))
+ 	    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 ****
--- 15830,15838 ----
  	    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,362 ****
    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
      {
        snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
--- 355,381 ----
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return get_identifier (sym->binding_label);
  
!   if (sym->fn_result_spec && sym->module)
!     {
!       /* 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)
!     if (!sym->fn_result_spec)
!       return gfc_sym_identifier (sym);
!     else
!       {
! 	snprintf (name, sizeof name, "__%s_PROC_%s",
! 		  sym->ns->proc_name->name, sym->name);
! 	return get_identifier (name);
!       }
    else
      {
        snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
*************** 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
--- 1647,1653 ----
    /* 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)
--- 1669,1675 ----
    /* 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);
--- 4772,4780 ----
  
    /* 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.  */
--- 6161,6168 ----
    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,103 ----
+ ! { 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.
+ !
+ ! The original version of the bug
+ MODULE Fruits0
+   IMPLICIT NONE
+   PRIVATE
+   PUBLIC :: Get0
+ CONTAINS
+   FUNCTION Get0(i) RESULT(s)
+     CHARACTER(*), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     !****
+     s = names(i)
+   END FUNCTION Get0
+ END MODULE Fruits0
+ !
+ ! Version that came about from sorting other issues.
+ 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 Fruits0
+   USE Fruits
+   IMPLICIT NONE
+   character(7) :: arg = ""
+   integer :: i
+ 
+ ! Test the fix for the original bug
+   if (len (Get0(1)) .ne. 5) call abort
+   if (Get0(2) .ne. "Orange") call abort
+ 
+ ! Test the fix for the subsequent issues
+   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
Index: gcc/testsuite/gfortran.dg/char_result_16.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_16.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/char_result_16.f90	(working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR44265. This test arose during review.
+ !
+ ! Contributed by Dominique d'Humeieres  <dominiq@lps.ens.fr>
+ !
+   FUNCTION Get(i) RESULT(s)
+     CHARACTER(*), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     !****
+     s = names(i)
+     print *, len(s)
+   END FUNCTION Get
+ 
+ PROGRAM WheresThatbLinkingConstantGone
+   IMPLICIT NONE
+   interface
+     FUNCTION Get(i) RESULT(s)
+       CHARACTER(*), PARAMETER :: names(3) = [  &
+                   'Apple  ',  &
+                   'Orange ',  &
+                   'Mango  ' ];
+       INTEGER, INTENT(IN) :: i
+       CHARACTER(LEN_TRIM(names(i))) :: s
+   END FUNCTION Get
+   end interface
+ 
+   if (len(Get(1)) .ne. 5) call abort
+   if (len(Get(2)) .ne. 6) call abort
+ END PROGRAM WheresThatbLinkingConstantGone

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Dominique d'Humières]

FAIL: gfortran.dg/char_result_16.f90   -g -flto  (internal compiler error)
FAIL: gfortran.dg/char_result_16.f90   -g -flto  (test for excess errors)

The ICE is for both -m32 and -m64 (module_procedure_3_db_1.f90 is the test posted in my last mail)

% gfc module_procedure_3_db_1.f90 -flto
module_procedure_3_db_1.f90:29:0: internal compiler error: in get_partitioning_class, at symtab.c:1848
 END PROGRAM WheresThatbLinkingConstantGone

Sorry to be such a nuisance!-(

Dominique

> Le 10 nov. 2016 à 15:49, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Hi Dominique.
> 
> ....snip....
>> I have a last glitch (which can be deferred if needed):
> ....snip....
> 
> Fixed by the new patch, which is attached. Bootstraps and regtests OK.
> 
> OK for trunk?
> 
> Paul
> 
> 2016-11-10  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-10  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.
>    * gfortran.dg/char_result_16.f90: New test.
> 
> 
> -- 
> The difference between genius and stupidity is; genius has its limits.
> 
> Albert Einstein

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Dominique d'Humières]

Dear Paul,

I have found another glitch with all the patches in this thread: they transform an ICE to accept-invalid for the tests z7.f90, z8.f90, and z9.f90 in pr77414.

Dominique

> Le 10 nov. 2016 à 23:48, Dominique d'Humières <dominiq@lps.ens.fr> a écrit :
> 
> FAIL: gfortran.dg/char_result_16.f90   -g -flto  (internal compiler error)
> FAIL: gfortran.dg/char_result_16.f90   -g -flto  (test for excess errors)
> 
> The ICE is for both -m32 and -m64 (module_procedure_3_db_1.f90 is the test posted in my last mail)
> 
> % gfc module_procedure_3_db_1.f90 -flto
> module_procedure_3_db_1.f90:29:0: internal compiler error: in get_partitioning_class, at symtab.c:1848
> END PROGRAM WheresThatbLinkingConstantGone
> 
> Sorry to be such a nuisance!-(
> 
> Dominique
> 

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Paul Richard Thomas]

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

Dear Dominique,

I will turn to the effect on PR77414 after committing the patch for PR44265.

The attached fixes the -flto problem. The chunk in
trans-decl.c(gfc_finish_var_decl) did the job. It is quite obvious now
and, in fact, I am a bit surprised that the patch worked at all
without the DECL_EXTERNAL.

Bootstraps and regtests on FC21/x86_64 - OK for trunk?

Paul

2016-12-07  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_finish_var_decl): Mark the decls of these symbols
    appropriately for the case where the function is external.
    (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-12-07  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.
    * gfortran.dg/char_result_16.f90: New test.
    * gfortran.dg/char_result_17.f90: New test.


On 7 December 2016 at 13:21, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> Dear Paul,
>
> I have found another glitch with all the patches in this thread: they transform an ICE to accept-invalid for the tests z7.f90, z8.f90, and z9.f90 in pr77414.
>
> Dominique
>
>> Le 10 nov. 2016 à 23:48, Dominique d'Humières <dominiq@lps.ens.fr> a écrit :
>>
>> FAIL: gfortran.dg/char_result_16.f90   -g -flto  (internal compiler error)
>> FAIL: gfortran.dg/char_result_16.f90   -g -flto  (test for excess errors)
>>
>> The ICE is for both -m32 and -m64 (module_procedure_3_db_1.f90 is the test posted in my last mail)
>>
>> % gfc module_procedure_3_db_1.f90 -flto
>> module_procedure_3_db_1.f90:29:0: internal compiler error: in get_partitioning_class, at symtab.c:1848
>> END PROGRAM WheresThatbLinkingConstantGone
>>
>> Sorry to be such a nuisance!-(
>>
>> Dominique
>>
>



-- 
If you're walking down the right path and you're willing to keep
walking, eventually you'll make progress.

Barack Obama

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

Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 243235)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct gfc_symbol
*** 1545,1550 ****
--- 1545,1552 ----
    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 243235)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_equivalence (gfc_equiv *eq)
*** 15755,15760 ****
--- 15755,15808 ----
  }
  
  
+ /* 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->attr.flavor == FL_PARAMETER)
+ 	{
+ 	  /* Function contained in a module.... */
+ 	  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++;
+ 	    }
+ 	  /* ... which is use associated and called.  */
+ 	  else if (s->attr.use_assoc || s->attr.used_in_submodule
+ 			||
+ 		  /* External function matched with an interface.  */
+ 		  (s->ns->proc_name
+ 		   && ((s->ns == ns
+ 			 && s->ns->proc_name->attr.if_source == IFSRC_DECL)
+ 		       || s->ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ 		   && s->ns->proc_name->attr.function))
+ 	    s->fn_result_spec = 1;
+ 	}
+     }
+   return false;
+ }
+ 
+ 
  /* Resolve function and ENTRY types, issue diagnostics if needed.  */
  
  static void
*************** resolve_fntype (gfc_namespace *ns)
*** 15805,15810 ****
--- 15853,15861 ----
  	    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 243235)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_new_symbol (const char *name, gfc_na
*** 2965,2970 ****
--- 2965,2971 ----
    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 243235)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_sym_mangled_identifier (gfc_symbol *
*** 356,367 ****
    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
      {
!       snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
!       return get_identifier (name);
      }
  }
  
--- 356,391 ----
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return get_identifier (sym->binding_label);
  
!   if (!sym->fn_result_spec)
!     {
!       if (sym->module == NULL)
! 	return gfc_sym_identifier (sym);
!       else
! 	{
! 	  snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
! 	  return get_identifier (name);
! 	}
!     }
    else
      {
!       /* 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. */
!       if (sym->ns->proc_name && sym->ns->proc_name->module)
! 	{
! 	  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
! 	{
! 	  snprintf (name, sizeof name, "__%s_PROC_%s",
! 		    sym->ns->proc_name->name, sym->name);
! 	  return get_identifier (name);
! 	}
      }
  }
  
*************** gfc_finish_var_decl (tree decl, gfc_symb
*** 615,620 ****
--- 639,654 ----
        DECL_EXTERNAL (decl) = 1;
        TREE_PUBLIC (decl) = 1;
      }
+   else if (sym->fn_result_spec && !sym->ns->proc_name->module)
+     {
+ 
+       if (sym->ns->proc_name->attr.if_source != IFSRC_DECL)
+ 	DECL_EXTERNAL (decl) = 1;
+       else
+ 	TREE_STATIC (decl) = 1;
+ 
+       TREE_PUBLIC (decl) = 1;
+     }
    else if (sym->module && !sym->attr.result && !sym->attr.dummy)
      {
        /* TODO: Don't set sym->module for result or dummy variables.  */
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1632,1638 ****
    /* 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
--- 1666,1672 ----
    /* 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)
*** 1654,1660 ****
    /* 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)
--- 1688,1694 ----
    /* 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 *
*** 4766,4772 ****
  
    /* 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);
--- 4800,4808 ----
  
    /* 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
*** 6153,6160 ****
    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.  */
--- 6189,6196 ----
    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 243235)
--- 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,103 ----
+ ! { 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.
+ !
+ ! The original version of the bug
+ MODULE Fruits0
+   IMPLICIT NONE
+   PRIVATE
+   PUBLIC :: Get0
+ CONTAINS
+   FUNCTION Get0(i) RESULT(s)
+     CHARACTER(*), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     !****
+     s = names(i)
+   END FUNCTION Get0
+ END MODULE Fruits0
+ !
+ ! Version that came about from sorting other issues.
+ 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 Fruits0
+   USE Fruits
+   IMPLICIT NONE
+   character(7) :: arg = ""
+   integer :: i
+ 
+ ! Test the fix for the original bug
+   if (len (Get0(1)) .ne. 5) call abort
+   if (Get0(2) .ne. "Orange") call abort
+ 
+ ! Test the fix for the subsequent issues
+   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
Index: gcc/testsuite/gfortran.dg/char_result_16.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_16.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/char_result_16.f90	(working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR44265. This test arose during review.
+ !
+ ! Contributed by Dominique d'Humeieres  <dominiq@lps.ens.fr>
+ !
+   FUNCTION Get(i) RESULT(s)
+     CHARACTER(*), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     !****
+     s = names(i)
+     print *, len(s)
+   END FUNCTION Get
+ 
+ PROGRAM WheresThatbLinkingConstantGone
+   IMPLICIT NONE
+   interface
+     FUNCTION Get(i) RESULT(s)
+       CHARACTER(*), PARAMETER :: names(3) = [  &
+                   'Apple  ',  &
+                   'Orange ',  &
+                   'Mango  ' ];
+       INTEGER, INTENT(IN) :: i
+       CHARACTER(LEN_TRIM(names(i))) :: s
+   END FUNCTION Get
+   end interface
+ 
+   if (len(Get(1)) .ne. 5) call abort
+   if (len(Get(2)) .ne. 6) call abort
+ END PROGRAM WheresThatbLinkingConstantGone
Index: gcc/testsuite/gfortran.dg/char_result_17.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_17.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/char_result_17.f90	(working copy)
***************
*** 0 ****
--- 1,36 ----
+ ! { dg-do run }
+ ! { dg-options "-flto" }
+ !
+ ! Tests the fix for PR44265. This test arose during review. It
+ ! would ICE on compilation with -flto.
+ !
+ ! Contributed by Dominique d'Humeieres  <dominiq@lps.ens.fr>
+ !
+   FUNCTION Get(i) RESULT(s)
+     CHARACTER(*), PARAMETER :: names(3) = [  &
+         'Apple  ',  &
+         'Orange ',  &
+         'Mango  ' ];
+     INTEGER, INTENT(IN) :: i
+     CHARACTER(LEN_TRIM(names(i))) :: s
+     !****
+     s = names(i)
+     print *, len(s)
+   END FUNCTION Get
+ 
+ PROGRAM WheresThatbLinkingConstantGone
+   IMPLICIT NONE
+   interface
+     FUNCTION Get(i) RESULT(s)
+       CHARACTER(*), PARAMETER :: names(3) = [  &
+                   'Apple  ',  &
+                   'Orange ',  &
+                   'Mango  ' ];
+       INTEGER, INTENT(IN) :: i
+       CHARACTER(LEN_TRIM(names(i))) :: s
+   END FUNCTION Get
+   end interface
+ 
+   if (len(Get(1)) .ne. 5) call abort
+   if (len(Get(2)) .ne. 6) call abort
+ END PROGRAM WheresThatbLinkingConstantGone

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Dominique d'Humières]

The tests gfortran.dg/char_result_16.f90 and gfortran.dg/char_result_17.f90 fail with

lto1: error: two or more sections for .gnu.lto___get_PROC_names.3e3ee55b08747e7c
lto1: internal compiler error: cannot read LTO decls from /var/folders/8q/sh_swgz96r7f5vnn08f7fxr00000gn/T//ccEJosbA.o

This may be darwin specific as the linker is more picky than the linux one.

Dominique

> Le 7 déc. 2016 à 16:47, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Dear Dominique,
> 
> I will turn to the effect on PR77414 after committing the patch for PR44265.
> 
> The attached fixes the -flto problem. The chunk in
> trans-decl.c(gfc_finish_var_decl) did the job. It is quite obvious now
> and, in fact, I am a bit surprised that the patch worked at all
> without the DECL_EXTERNAL.
> 
> Bootstraps and regtests on FC21/x86_64 - OK for trunk?
> 
> Paul
> 
> 2016-12-07  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_finish_var_decl): Mark the decls of these symbols
>    appropriately for the case where the function is external.
>    (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-12-07  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.
>    * gfortran.dg/char_result_16.f90: New test.
>    * gfortran.dg/char_result_17.f90: New test.
> 
> 

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Paul Richard Thomas]

Dear Dominique,

Thanks for the feedback. However, I don't know what to do about it.
Perhaps I should commit the patch without char_result_[16,17].f90 and
pass it on to somebody who is a bit more conversent with these issues?
As far as I am concerned, it is fixed on Linux.

Any ideas anybody?

Paul

On 7 December 2016 at 20:11, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> The tests gfortran.dg/char_result_16.f90 and gfortran.dg/char_result_17.f90 fail with
>
> lto1: error: two or more sections for .gnu.lto___get_PROC_names.3e3ee55b08747e7c
> lto1: internal compiler error: cannot read LTO decls from /var/folders/8q/sh_swgz96r7f5vnn08f7fxr00000gn/T//ccEJosbA.o
>
> This may be darwin specific as the linker is more picky than the linux one.
>
> Dominique
>
>> Le 7 déc. 2016 à 16:47, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>>
>> Dear Dominique,
>>
>> I will turn to the effect on PR77414 after committing the patch for PR44265.
>>
>> The attached fixes the -flto problem. The chunk in
>> trans-decl.c(gfc_finish_var_decl) did the job. It is quite obvious now
>> and, in fact, I am a bit surprised that the patch worked at all
>> without the DECL_EXTERNAL.
>>
>> Bootstraps and regtests on FC21/x86_64 - OK for trunk?
>>
>> Paul
>>
>> 2016-12-07  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_finish_var_decl): Mark the decls of these symbols
>>    appropriately for the case where the function is external.
>>    (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-12-07  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.
>>    * gfortran.dg/char_result_16.f90: New test.
>>    * gfortran.dg/char_result_17.f90: New test.
>>
>>
>



-- 
If you're walking down the right path and you're willing to keep
walking, eventually you'll make progress.

Barack Obama

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Andre Vehreschild]

Hi Paul,

When you can narrow it down to only failing on Darwin, then filter the testcases not to run on that system.

- Andre

Am 7. Dezember 2016 22:44:15 MEZ, schrieb Paul Richard Thomas <paul.richard.thomas@gmail.com>:
>Dear Dominique,
>
>Thanks for the feedback. However, I don't know what to do about it.
>Perhaps I should commit the patch without char_result_[16,17].f90 and
>pass it on to somebody who is a bit more conversent with these issues?
>As far as I am concerned, it is fixed on Linux.
>
>Any ideas anybody?
>
>Paul
>
>On 7 December 2016 at 20:11, Dominique d'Humières <dominiq@lps.ens.fr>
>wrote:
>> The tests gfortran.dg/char_result_16.f90 and
>gfortran.dg/char_result_17.f90 fail with
>>
>> lto1: error: two or more sections for
>.gnu.lto___get_PROC_names.3e3ee55b08747e7c
>> lto1: internal compiler error: cannot read LTO decls from
>/var/folders/8q/sh_swgz96r7f5vnn08f7fxr00000gn/T//ccEJosbA.o
>>
>> This may be darwin specific as the linker is more picky than the
>linux one.
>>
>> Dominique
>>
>>> Le 7 déc. 2016 à 16:47, Paul Richard Thomas
><paul.richard.thomas@gmail.com> a écrit :
>>>
>>> Dear Dominique,
>>>
>>> I will turn to the effect on PR77414 after committing the patch for
>PR44265.
>>>
>>> The attached fixes the -flto problem. The chunk in
>>> trans-decl.c(gfc_finish_var_decl) did the job. It is quite obvious
>now
>>> and, in fact, I am a bit surprised that the patch worked at all
>>> without the DECL_EXTERNAL.
>>>
>>> Bootstraps and regtests on FC21/x86_64 - OK for trunk?
>>>
>>> Paul
>>>
>>> 2016-12-07  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_finish_var_decl): Mark the decls of these symbols
>>>    appropriately for the case where the function is external.
>>>    (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-12-07  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.
>>>    * gfortran.dg/char_result_16.f90: New test.
>>>    * gfortran.dg/char_result_17.f90: New test.
>>>
>>>
>>

-- 
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 929 10 18 * vehre@gmx.de

Re: [Patch, fortran] PR44265 - Link error with reference to parameter array in specification expression

[Paul Richard Thomas]

Dear All,

Following a discussion on #gfortran with Andre and Dominique the patch
has been committed without char_result_[16,17].f90 as revision 243478.

This has been one of the most ill-starred of any patch that I have
submitted. At the last moment, I found that char_result_14.f90 was
suffering from excess errors due to the introduction of
Wstringop-overflow at -O3. The odd thing is that this warning is not
explicitly available to fortran so it cannot be switched off. I
introduced this chunk to fix it:

*************** gfc_trans_string_copy (stmtblock_t * blo
*** 6484,6493 ****
                    builtin_decl_explicit (BUILT_IN_MEMMOVE),
                    3, dest, src, slen);

    tmp4 = fold_build_pointer_plus_loc (input_location, dest, slen);
!   tmp4 = fill_with_spaces (tmp4, chartype,
!                fold_build2_loc (input_location, MINUS_EXPR,
!                         TREE_TYPE(dlen), dlen, slen));

    gfc_init_block (&tempblock);
    gfc_add_expr_to_block (&tempblock, tmp3);
--- 6494,6511 ----
                    builtin_decl_explicit (BUILT_IN_MEMMOVE),
                    3, dest, src, slen);

+   /* Wstringop-overflow appears at -O3 even though this warning is not
+      explicitly available in fortran nor can it be switched off. If the
+      source length is a constant, its negative appears as a very large
+      postive number and triggers the warning in BUILTIN_MEMSET. Fixing
+      the result of the MINUS_EXPR suppresses this spurious warning.  */
+   tmp = fold_build2_loc (input_location, MINUS_EXPR,
+              TREE_TYPE(dlen), dlen, slen);
+   if (slength && TREE_CONSTANT (slength))
+     tmp = gfc_evaluate_now (tmp, block);
+
    tmp4 = fold_build_pointer_plus_loc (input_location, dest, slen);
!   tmp4 = fill_with_spaces (tmp4, chartype, tmp);

    gfc_init_block (&tempblock);
    gfc_add_expr_to_block (&tempblock, tmp3);

I am changing the PR to reflect the continuing problem with Darwin.

Cheers

Paul


On 7 December 2016 at 22:50, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Paul,
>
> When you can narrow it down to only failing on Darwin, then filter the testcases not to run on that system.
>
> - Andre
>
> Am 7. Dezember 2016 22:44:15 MEZ, schrieb Paul Richard Thomas <paul.richard.thomas@gmail.com>:
>>Dear Dominique,
>>
>>Thanks for the feedback. However, I don't know what to do about it.
>>Perhaps I should commit the patch without char_result_[16,17].f90 and
>>pass it on to somebody who is a bit more conversent with these issues?
>>As far as I am concerned, it is fixed on Linux.
>>
>>Any ideas anybody?
>>
>>Paul
>>
>>On 7 December 2016 at 20:11, Dominique d'Humières <dominiq@lps.ens.fr>
>>wrote:
>>> The tests gfortran.dg/char_result_16.f90 and
>>gfortran.dg/char_result_17.f90 fail with
>>>
>>> lto1: error: two or more sections for
>>.gnu.lto___get_PROC_names.3e3ee55b08747e7c
>>> lto1: internal compiler error: cannot read LTO decls from
>>/var/folders/8q/sh_swgz96r7f5vnn08f7fxr00000gn/T//ccEJosbA.o
>>>
>>> This may be darwin specific as the linker is more picky than the
>>linux one.
>>>
>>> Dominique
>>>
>>>> Le 7 déc. 2016 à 16:47, Paul Richard Thomas
>><paul.richard.thomas@gmail.com> a écrit :
>>>>
>>>> Dear Dominique,
>>>>
>>>> I will turn to the effect on PR77414 after committing the patch for
>>PR44265.
>>>>
>>>> The attached fixes the -flto problem. The chunk in
>>>> trans-decl.c(gfc_finish_var_decl) did the job. It is quite obvious
>>now
>>>> and, in fact, I am a bit surprised that the patch worked at all
>>>> without the DECL_EXTERNAL.
>>>>
>>>> Bootstraps and regtests on FC21/x86_64 - OK for trunk?
>>>>
>>>> Paul
>>>>
>>>> 2016-12-07  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_finish_var_decl): Mark the decls of these symbols
>>>>    appropriately for the case where the function is external.
>>>>    (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-12-07  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.
>>>>    * gfortran.dg/char_result_16.f90: New test.
>>>>    * gfortran.dg/char_result_17.f90: New test.
>>>>
>>>>
>>>
>
> --
> Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> Tel.: +49 241 929 10 18 * vehre@gmx.de



-- 
If you're walking down the right path and you're willing to keep
walking, eventually you'll make progress.

Barack Obama