procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/25964 (NIST regression on fm311.f)

Browse source 
2005-01-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25964
	* resolve.c (resolve_function): Exclude statement functions from
	global reference checking.

	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. Emit warning
	that character(*) value functions are obsolescent in F95.

	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.

	Cure temp name confusion.
	* trans-expr.c (gfc_get_interface_mapping_array): Change name of
	temporary from "parm" to "ifm" to avoid clash with temp coming from
	trans-array.c.

2005-01-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25964
	* gfortran.dg/global_references_2.f90: New test.

	PR fortran/25084
	PR fortran/20852
	PR fortran/25085
	PR fortran/25086
	* gfortran.dg/assumed_charlen_function_1.f90: New test.
	* gfortran.dg/assumed_charlen_function_3.f90: New test.

	PR fortran/25416
	* gfortran.dg/assumed_charlen_function_2.f90: New test.

From-SVN: r110269
This commit is contained in:
Paul Thomas 2006-01-26 20:19:09 +00:00
parent e8b053801c
commit 20236f90d9
8 changed files with 294 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
gcc/fortran/ChangeLog
View file

@ -1,3 +1,35 @@
2005-01-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25964
* resolve.c (resolve_function): Exclude statement functions from
global reference checking.
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. Emit warning
that character(*) value functions are obsolescent in F95.
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.
Cure temp name confusion.
* trans-expr.c (gfc_get_interface_mapping_array): Change name of
temporary from "parm" to "ifm" to avoid clash with temp coming from
trans-array.c.
2005-01-25 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25716

87
gcc/fortran/resolve.c
View file

@ -1183,17 +1183,21 @@ static try
resolve_function (gfc_expr * expr)
{
gfc_actual_arglist *arg;
gfc_symbol * sym;
const char *name;
try t;
int temp;
/* If the procedure is not internal or module, it must be external and
should be checked for usage. */
if (expr->symtree && expr->symtree->n.sym
&& !expr->symtree->n.sym->attr.dummy
&& !expr->symtree->n.sym->attr.contained
&& !expr->symtree->n.sym->attr.use_assoc)
resolve_global_procedure (expr->symtree->n.sym, &expr->where, 0);
sym = NULL;
if (expr->symtree)
sym = expr->symtree->n.sym;
/* If the procedure is not internal, a statement function or a module
procedure,it must be external and should be checked for usage. */
if (sym && !sym->attr.dummy && !sym->attr.contained
&& sym->attr.proc != PROC_ST_FUNCTION
&& !sym->attr.use_assoc)
resolve_global_procedure (sym, &expr->where, 0);
/* Switch off assumed size checking and do this again for certain kinds
of procedure, once the procedure itself is resolved. */
@ -1205,19 +1209,44 @@ resolve_function (gfc_expr * expr)
/* Resume assumed_size checking. */
need_full_assumed_size--;
if (sym && sym->ts.type == BT_CHARACTER
&& sym->ts.cl && sym->ts.cl->length == NULL)
{
if (sym->attr.if_source == IFSRC_IFBODY)
{
/* This follows from a slightly odd requirement at 5.1.1.5 in the
standard that allows assumed character length functions to be
declared in interfaces but not used. Picking up the symbol here,
rather than resolve_symbol, accomplishes that. */
gfc_error ("Function '%s' can be declared in an interface to "
"return CHARACTER(*) but cannot be used at %L",
sym->name, &expr->where);
return FAILURE;
}
/* Internal procedures are taken care of in resolve_contained_fntype. */
if (!sym->attr.dummy && !sym->attr.contained)
{
gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
"be used at %L since it is not a dummy argument",
sym->name, &expr->where);
return FAILURE;
}
}
/* See if function is already resolved. */
if (expr->value.function.name != NULL)
{
if (expr->ts.type == BT_UNKNOWN)
expr->ts = expr->symtree->n.sym->ts;
expr->ts = sym->ts;
t = SUCCESS;
}
else
{
/* Apply the rules of section 14.1.2. */
switch (procedure_kind (expr->symtree->n.sym))
switch (procedure_kind (sym))
{
case PTYPE_GENERIC:
t = resolve_generic_f (expr);
@ -4862,6 +4891,46 @@ resolve_symbol (gfc_symbol * sym)
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)
{
if ((sym->as && sym->as->rank) || (sym->attr.pointer)
|| (sym->attr.recursive) || (sym->attr.pure))
{
if (sym->as && sym->as->rank)
gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
"array-valued", sym->name, &sym->declared_at);
if (sym->attr.pointer)
gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
"pointer-valued", sym->name, &sym->declared_at);
if (sym->attr.pure)
gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
"pure", sym->name, &sym->declared_at);
if (sym->attr.recursive)
gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
"recursive", sym->name, &sym->declared_at);
return;
}
/* Appendix B.2 of the standard. Contained functions give an
error anyway. Fixed-form is likely to be F77/legacy. */
if (!sym->attr.contained && gfc_current_form != FORM_FIXED)
gfc_notify_std (GFC_STD_F95_OBS, "CHARACTER(*) function "
"'%s' at %L is obsolescent in fortran 95",
sym->name, &sym->declared_at);
}
break;
case FL_DERIVED:

35
gcc/fortran/trans-expr.c
View file

@ -1224,7 +1224,7 @@ gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
type = gfc_typenode_for_spec (&sym->ts);
type = gfc_get_nodesc_array_type (type, sym->as, packed);
var = gfc_create_var (type, "parm");
var = gfc_create_var (type, "ifm");
gfc_add_modify_expr (block, var, fold_convert (type, data));
return var;
@ -1807,8 +1807,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
gfc_init_interface_mapping (&mapping);
need_interface_mapping = ((sym->ts.type == BT_CHARACTER
&& sym->ts.cl->length->expr_type != EXPR_CONSTANT)
|| sym->attr.dimension);
&& sym->ts.cl->length
&& sym->ts.cl->length->expr_type
!= EXPR_CONSTANT)
|| sym->attr.dimension);
formal = sym->formal;
/* Evaluate the arguments. */
for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
@ -1905,19 +1907,30 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
ts = sym->ts;
if (ts.type == BT_CHARACTER)
{
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
if (need_interface_mapping)
gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
if (sym->ts.cl->length == NULL)
{
/* Assumed character length results are not allowed by 5.1.1.5 of the
standard and are trapped in resolve.c; except in the case of SPREAD
(and other intrinsics?). In this case, we take the character length
of the first argument for the result. */
cl.backend_decl = TREE_VALUE (stringargs);
}
else
gfc_conv_expr (&parmse, sym->ts.cl->length);
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
{
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
if (need_interface_mapping)
gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
else
gfc_conv_expr (&parmse, sym->ts.cl->length);
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr);
}
/* Set up a charlen structure for it. */
cl.next = NULL;
cl.length = NULL;
cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr);
ts.cl = &cl;
len = cl.backend_decl;

15
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,18 @@
2005-01-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25964
* gfortran.dg/global_references_2.f90: New test.
PR fortran/25084
PR fortran/20852
PR fortran/25085
PR fortran/25086
* gfortran.dg/assumed_charlen_function_1.f90: New test.
* gfortran.dg/assumed_charlen_function_3.f90: New test.
PR fortran/25416
* gfortran.dg/assumed_charlen_function_2.f90: New test.
2006-01-26 Alexandre Oliva <aoliva@redhat.com>
PR c/25892

83
gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 Normal file
View file

@ -0,0 +1,83 @@
! { dg-do compile }
! { dg-options "-std=legacy" }
! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of
! which involve assumed character length functions.
! Compiled from original PR testcases, which were all contributed
! by Joost VandeVondele <jv244@cam.ac.uk>
!
! PR25084 - the error is not here but in any use of .IN.
! It is OK to define an assumed character length function
! in an interface but it cannot be invoked (5.1.1.5).
MODULE M1
TYPE SET
INTEGER CARD
END TYPE SET
END MODULE M1
MODULE INTEGER_SETS
INTERFACE OPERATOR (.IN.)
FUNCTION ELEMENT(X,A)
USE M1
CHARACTER(LEN=*) :: ELEMENT
INTEGER, INTENT(IN) :: X
TYPE(SET), INTENT(IN) :: A
END FUNCTION ELEMENT
END INTERFACE
END MODULE
! 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
!
! PR20852
RECURSIVE FUNCTION TEST() ! { dg-error "cannot be recursive" }
CHARACTER(LEN=*) :: TEST
TEST = ""
END FUNCTION
!PR25085
FUNCTION F1() ! { dg-error "cannot be array-valued" }
CHARACTER(LEN=*), DIMENSION(10) :: F1
F1 = ""
END FUNCTION F1
!PR25086
FUNCTION F2() result(f4) ! { dg-error "cannot be pointer-valued" }
CHARACTER(LEN=*), POINTER :: f4
f4 = ""
END FUNCTION F2
!PR?????
pure FUNCTION F3() ! { dg-error "cannot be pure" }
CHARACTER(LEN=*) :: F3
F3 = ""
END FUNCTION F3
function not_OK (ch)
character(*) not_OK, ch ! OK in an external function
not_OK = ch
end function not_OK
use INTEGER_SETS
use m1
character(4) :: answer
character(*), external :: not_OK
integer :: i
type (set) :: z
interface
function ext (i)
character(*) :: ext
integer :: i
end function ext
end interface
answer = i.IN.z ! { dg-error "cannot be used|Operands of user operator" }
answer = ext (2) ! { dg-error "but cannot be used" }
answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }
END

13
gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90 Normal file
View file

@ -0,0 +1,13 @@
! { dg-do compile }
! Tests the fix for PR25416, which ICED in gfc_conv_function_call, when
! treating SPREAD in the statement below.
!
! Contributed by Ulrich Weigand <uweigand@gcc.gnu.org>
function bug(self,strvec) result(res)
character(*) :: self
character(*), dimension(:), intent(in) :: strvec
logical(kind=kind(.true.)) :: res
res = any(index(strvec,spread(self,1,size(strvec))) /= 0)
end function

39
gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90 Normal file
View file

@ -0,0 +1,39 @@
! { dg-do compile }
! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of
! which involve assumed character length functions.
! This test checks the things that should not emit errors.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
function is_OK (ch) ! { dg-warning "is obsolescent in fortran 95" }
character(*) is_OK, ch ! OK in an external function
is_OK = ch
end function is_OK
! The warning occurs twice for the next line; for 'more_OK' and for 'fcn';
function more_OK (ch, fcn) ! { dg-warning "is obsolescent in fortran 95" }
character(*) more_OK, ch
character (*), external :: fcn ! OK as a dummy argument
more_OK = fcn (ch)
end function more_OK
character(4) :: answer
character(4), external :: is_OK, more_OK
answer = is_OK ("isOK") ! LEN defined in calling scope
print *, answer
answer = more_OK ("okay", is_OK) ! Actual arg has defined LEN
print *, answer
answer = also_OK ("OKOK")
print *, answer
contains
function also_OK (ch)
character(4) also_OK
character(*) ch
also_OK = is_OK (ch) ! LEN obtained by host association
end function also_OK
END

10
gcc/testsuite/gfortran.dg/global_references_2.f90 Normal file
View file

@ -0,0 +1,10 @@
! { dg-do compile }
! This program tests the patch for PR25964. This is a
! regression that would not allow a common block and a statement
! to share the same name.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
common /foo/ a, b, c
foo (x) = x + 1.0
print *, foo (0.0)
end