Re: [Patch, fortran] PR25084, PR20852, PR25085, PR25086 & PR25416 - assumed character length functions

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

Paul Thomas wrote:
> 2005-01-25  Paul Thomas  <pault@gcc.gnu.org>
> 
>     PR fortran/25084
>     PR fortran/20852
>     PR fortran/25085
>     PR fortran/25086
>     * resolve.c (resolve_function): Declare a gfc_symbol to replace the 
> references
>     through the symtree to the symbol associated with the function 
> expresion. Give
>     error on reference to an assumed character length function is 
> defined in an
>     interface or an external function that is not a dummy argument.
>     (resolve_symbol): Give error if an assumed character length function 
> is array-
>     valued, pointer-valued, pure or recursive.
> 
>     PR fortran/25416
>     * trans-expr.c (gfc_conv_function_call): The above patch to 
> resolve.c prevents
>     any assumed character length function call from getting here, except 
> intrinsics
>     such as SPREAD. In this case, ensure that no segfault occurs from 
> referencing
>     non-existent charlen->length->expr_type and provide a backend_decl 
> for the
>     charlen from the charlen of the first actual argument.
> 
> 2005-01-25  Paul Thomas  <pault@gcc.gnu.org>
> 
>     PR fortran/25084
>     PR fortran/20852
>     PR fortran/25085
>     PR fortran/25086
>     * gfortran.dg/assumed_charlen_function_1.f90: New test for constraints.
>     * gfortran.dg/assumed_charlen_function_3.f90: New test for what 
> should compile.
> 
>     PR fortran/25416
>     * gfortran.dg/assumed_charlen_function_2.f90: New test for *-charlen 
> in SPREAD.

This is ok, modulo two remarks.  Also, please make sure that the ChangeLog
lines are not longer than 78 columns (or whatever emacs' fill-paragraph makes
them), as that way you avoid wrapping in mail and in the editors of people who
don't use windows wider than 80 columns.

Feel free to add an obsolescence warning, and consider that (part of the)
patch pre-approved.

> !       if (sym->ts.cl->length == NULL)
> ! 	{
> ! 	  /* Assumed character length results are not allowed by 5.1.1.5 of the
> ! 	     standard; except in the case of SPREAD(and other intrinsics?). All
> ! 	     other calls with *-charlen results are trapped in resolve.c. Since
> ! 	     it is unambiguously an intrinsic like SPREAD that gets us here, we
> ! 	     take the character length of the first argument for the result.  */
> ! 	  cl.backend_decl = TREE_VALUE (stringargs);
> ! 	}

Please add an assert that the callee is indeed an intrinsic.  I think the
comment is overly verbose, especially with the assert added, but I'm not
complaining.


> *************** resolve_symbol (gfc_symbol * sym)
> *** 4861,4866 ****
> --- 4888,4922 ----
>   	  return;
>   	}
>   
> +       /* 5.1.1.5 of the Standard: A function name declared with an asterisk
> + 	 char-len-param shall not be array-valued, pointer-valued, recursive
> + 	 or pure.  ....snip... A character value of * may only be used in the
> + 	 following ways: (i) Dummy arg of procedure - dummy associates with
> + 	 actual length; (ii) To declare a named constant; or (iii) External
> + 	 function - but length must be declared in calling scoping unit.  */
> +       if (sym->attr.function
> + 	    && sym->ts.type == BT_CHARACTER
> + 	    && sym->ts.cl && sym->ts.cl->length == NULL
> + 	    && ((sym->as && sym->as->rank) || (sym->attr.pointer)
> + 		  || (sym->attr.recursive) || (sym->attr.pure)))
> + 	{
> + 	  const char * type;
> + 	  if (sym->as && sym->as->rank)
> + 	    type = "array-valued";
> + 	  else if (sym->attr.pointer)
> + 	    type = "pointer-valued";
> + 	  else if (sym->attr.pure)
> + 	    type = "pure";
> + 	  else if (sym->attr.recursive)
> + 	    type = "recursive";
> + 	  else
> + 	    type = "";
> + 
> + 	  gfc_error ("CHARACTER(*) function '%s' at %L cannot be %s",
> + 		     sym->name, &sym->declared_at, type);
> + 	  return;
> + 	}

This type of coding breaks the effort FX put into internationalization.
Please make this
 if (sym->as && sym->as->rank)
     type = "CHARACTER(*) function '%s' at %L cannot be array-valued";
 else if (sym->attr.pointer)
     type = "CHARACTER(*) function '%s' at %L cannot be pointer-valued";
etc.

Or even better:
 if (sym->as && sym->as->rank)
     gfc_error ("CHARACTER(*) function '%s' at %L cannot be array-valued",
                sym->name, &sym->declared_at, type);
 if (sym->attr.pointer)
     gfc_error ("CHARACTER(*) function '%s' at %L cannot be pointer-valued",
                sym->name, &sym->declared_at, type);
 etc.

This way would cure all possible internationalization woes, and give errors
for all illegal attributes, not only the first checked for.

Thanks,
- Tobi