aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog32
-rw-r--r--gcc/fortran/resolve.c87
-rw-r--r--gcc/fortran/trans-expr.c35
-rw-r--r--gcc/testsuite/ChangeLog15
-rw-r--r--gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f9083
-rw-r--r--gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f9039
-rw-r--r--gcc/testsuite/gfortran.dg/global_references_2.f9010
8 files changed, 294 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4fa765b..7fc7fb0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e94a926..99fb2a2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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:
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b30a121..2322705 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7b2477a..f315158 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
new file mode 100644
index 0000000..c90617d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
@@ -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
+
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90
new file mode 100644
index 0000000..bd7d713
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90
@@ -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
+
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90
new file mode 100644
index 0000000..09c9be9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90
@@ -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
+
diff --git a/gcc/testsuite/gfortran.dg/global_references_2.f90 b/gcc/testsuite/gfortran.dg/global_references_2.f90
new file mode 100644
index 0000000..9566698
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_references_2.f90
@@ -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 \ No newline at end of file
generated by cgit v1.1 at 2025-12-29 02:58:50 +0000