aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2017-10-04 10:43:45 +0000
committerPaul Thomas <pault@gcc.gnu.org>2017-10-04 10:43:45 +0000
commit707905d0773e5a8eebb9ba65164f43dc08c658b1 (patch)
tree766b6c1e28ec2bb871c6783225573d614c75b16a /gcc/fortran
parent3e3d1b2326f7c78279275c91b21de38c388ff8fe (diff)
downloadgcc-707905d0773e5a8eebb9ba65164f43dc08c658b1.zip
gcc-707905d0773e5a8eebb9ba65164f43dc08c658b1.tar.gz
gcc-707905d0773e5a8eebb9ba65164f43dc08c658b1.tar.bz2
re PR fortran/60458 (Error message on associate: deferred type parameter and requires either the pointer or allocatable attribute)
2017-10-04 Paul Thomas <pault@gcc.gnu.org> PR fortran/60458 PR fortran/77296 * resolve.c (resolve_assoc_var): Deferred character type associate names must not receive an integer conatant length. * symbol.c (gfc_is_associate_pointer): Deferred character length functions also require an associate pointer. * trans-decl.c (gfc_get_symbol_decl): Deferred character length functions or derived type components require the assoc name to have variable string length. * trans-stmt.c (trans_associate_var): Set the string length of deferred string length associate names. The address expression is not needed for allocatable, pointer or dummy targets. Change the comment about defered string length targets. 2017-10-04 Paul Thomas <pault@gcc.gnu.org> PR fortran/77296 * gfortran.dg/associate_32.f03 : New test. From-SVN: r253400
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog16
-rw-r--r--gcc/fortran/resolve.c2
-rw-r--r--gcc/fortran/symbol.c6
-rw-r--r--gcc/fortran/trans-decl.c8
-rw-r--r--gcc/fortran/trans-stmt.c45
5 files changed, 73 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6f904b1..c38b34b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2017-10-04 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/60458
+ PR fortran/77296
+ * resolve.c (resolve_assoc_var): Deferred character type
+ associate names must not receive an integer conatant length.
+ * symbol.c (gfc_is_associate_pointer): Deferred character
+ length functions also require an associate pointer.
+ * trans-decl.c (gfc_get_symbol_decl): Deferred character
+ length functions or derived type components require the assoc
+ name to have variable string length.
+ * trans-stmt.c (trans_associate_var): Set the string length of
+ deferred string length associate names. The address expression
+ is not needed for allocatable, pointer or dummy targets. Change
+ the comment about defered string length targets.
+
2017-10-03 Thomas Koenig <tkoenig@gcc.gnu.org>
* io.c (match_wait_element): Correctly match END and EOR tags.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 698cf6d..e6f95d5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8530,7 +8530,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (!sym->ts.u.cl)
sym->ts.u.cl = target->ts.u.cl;
- if (!sym->ts.u.cl->length)
+ if (!sym->ts.u.cl->length && !sym->ts.deferred)
sym->ts.u.cl->length
= gfc_get_int_expr (gfc_default_integer_kind,
NULL, target->value.character.length);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 68a76c4..4c109fd 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -5054,6 +5054,12 @@ gfc_is_associate_pointer (gfc_symbol* sym)
if (sym->ts.type == BT_CLASS)
return true;
+ if (sym->ts.type == BT_CHARACTER
+ && sym->ts.deferred
+ && sym->assoc->target
+ && sym->assoc->target->expr_type == EXPR_FUNCTION)
+ return true;
+
if (!sym->assoc->variable)
return false;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d227d51..b4f515f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1695,6 +1695,14 @@ gfc_get_symbol_decl (gfc_symbol * sym)
if (sym->ts.type == BT_CHARACTER)
{
if (sym->attr.associate_var
+ && sym->ts.deferred
+ && sym->assoc && sym->assoc->target
+ && ((sym->assoc->target->expr_type == EXPR_VARIABLE
+ && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
+ || sym->assoc->target->expr_type == EXPR_FUNCTION))
+ sym->ts.u.cl->backend_decl = NULL_TREE;
+
+ if (sym->attr.associate_var
&& sym->ts.u.cl->backend_decl
&& VAR_P (sym->ts.u.cl->backend_decl))
length = gfc_index_zero_node;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 925ea63..7a76b8e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1533,6 +1533,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
bool need_len_assign;
bool whole_array = true;
gfc_ref *ref;
+ symbol_attribute attr;
gcc_assert (sym->assoc);
e = sym->assoc->target;
@@ -1592,6 +1593,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_conv_expr_descriptor (&se, e);
+ if (sym->ts.type == BT_CHARACTER
+ && sym->ts.deferred
+ && !sym->attr.select_type_temporary
+ && VAR_P (sym->ts.u.cl->backend_decl)
+ && se.string_length != sym->ts.u.cl->backend_decl)
+ {
+ gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
+ fold_convert (gfc_charlen_type_node,
+ se.string_length));
+ }
+
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
if ((!sym->assoc->variable && !cst_array_ctor)
@@ -1758,8 +1770,35 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER;
}
- tmp = TREE_TYPE (sym->backend_decl);
- tmp = gfc_build_addr_expr (tmp, se.expr);
+ if (sym->ts.type == BT_CHARACTER
+ && sym->ts.deferred
+ && !sym->attr.select_type_temporary
+ && VAR_P (sym->ts.u.cl->backend_decl)
+ && se.string_length != sym->ts.u.cl->backend_decl)
+ {
+ gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
+ fold_convert (gfc_charlen_type_node,
+ se.string_length));
+ if (e->expr_type == EXPR_FUNCTION)
+ {
+ tmp = gfc_call_free (sym->backend_decl);
+ gfc_add_expr_to_block (&se.post, tmp);
+ }
+ }
+
+ attr = gfc_expr_attr (e);
+ if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER
+ && (attr.allocatable || attr.pointer || attr.dummy))
+ {
+ /* These are pointer types already. */
+ tmp = fold_convert (TREE_TYPE (sym->backend_decl), se.expr);
+ }
+ else
+ {
+ tmp = TREE_TYPE (sym->backend_decl);
+ tmp = gfc_build_addr_expr (tmp, se.expr);
+ }
+
gfc_add_modify (&se.pre, sym->backend_decl, tmp);
gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
@@ -1784,7 +1823,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_init_se (&se, NULL);
if (e->symtree->n.sym->ts.type == BT_CHARACTER)
{
- /* What about deferred strings? */
+ /* Deferred strings are dealt with in the preceeding. */
gcc_assert (!e->symtree->n.sym->ts.deferred);
tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
}
generated by cgit v1.1 at 2025-03-24 16:46:01 +0000