aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog31
-rw-r--r--gcc/fortran/interface.c25
-rw-r--r--gcc/fortran/parse.c5
-rw-r--r--gcc/fortran/resolve.c55
-rw-r--r--gcc/fortran/trans-expr.c6
5 files changed, 92 insertions, 30 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aeb3cb9..ce38af8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,34 @@
+2006-08-30 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28885
+ REGRESSION FIX
+ * trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
+ declaration is retained for INTENT(OUT) arguments.
+
+ PR fortran/28873
+ REGRESSION FIX
+ PR fortran/20067
+ * resolve.c (resolve_generic_f): Make error message more
+ comprehensible.
+ (resolve_generic_s): Restructure search for specific procedures
+ to be similar to resolve_generic_f and change to similar error
+ message. Ensure that symbol reference is refreshed, in case
+ the search produces a NULL.
+ (resolve_specific_s): Restructure search, as above and as
+ resolve_specific_f. Ensure that symbol reference is refreshed,
+ in case the search produces a NULL.
+
+ PR fortran/25077
+ PR fortran/25102
+ * interface.c (check_operator_interface): Throw error if the
+ interface assignment tries to change intrinsic type assigments
+ or has less than two arguments. Also, it is an error if an
+ interface operator contains an alternate return.
+
+ PR fortran/24866
+ * parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
+ if it is a dummy in the contained namespace.
+
2006-08-29 Steven G. Kargl <kargls@comcast.net>
PR fortran/28866
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f1d968d..47fc79b 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -503,7 +503,12 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
for (formal = intr->sym->formal; formal; formal = formal->next)
{
sym = formal->sym;
-
+ if (sym == NULL)
+ {
+ gfc_error ("Alternate return cannot appear in operator "
+ "interface at %L", &intr->where);
+ return;
+ }
if (args == 0)
{
t1 = sym->ts.type;
@@ -531,6 +536,24 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
&intr->where);
return;
}
+ if (args != 2)
+ {
+ gfc_error
+ ("Assignment operator interface at %L must have two arguments",
+ &intr->where);
+ return;
+ }
+ if (sym->formal->sym->ts.type != BT_DERIVED
+ && sym->formal->next->sym->ts.type != BT_DERIVED
+ && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
+ || (gfc_numeric_ts (&sym->formal->sym->ts)
+ && gfc_numeric_ts (&sym->formal->next->sym->ts))))
+ {
+ gfc_error
+ ("Assignment operator interface at %L must not redefine "
+ "an INTRINSIC type assignment", &intr->where);
+ return;
+ }
}
else
{
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0416d28..9ac7e45 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2706,8 +2706,9 @@ gfc_fixup_sibling_symbols (gfc_symbol * sym, gfc_namespace * siblings)
for (ns = siblings; ns; ns = ns->sibling)
{
gfc_find_sym_tree (sym->name, ns, 0, &st);
- if (!st)
- continue;
+
+ if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
+ continue;
old_sym = st->n.sym;
if ((old_sym->attr.flavor == FL_PROCEDURE
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3924dc6..f1606b1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1181,7 +1181,7 @@ generic:
if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
{
- gfc_error ("Generic function '%s' at %L is not an intrinsic function",
+ gfc_error ("There is no specific function for the generic '%s' at %L",
expr->symtree->n.sym->name, &expr->where);
return FAILURE;
}
@@ -1614,31 +1614,31 @@ resolve_generic_s (gfc_code * c)
sym = c->symtree->n.sym;
- m = resolve_generic_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
-
- if (sym->ns->parent != NULL && !sym->attr.use_assoc)
+ for (;;)
{
+ m = resolve_generic_s0 (c, sym);
+ if (m == MATCH_YES)
+ return SUCCESS;
+ else if (m == MATCH_ERROR)
+ return FAILURE;
+
+generic:
+ if (sym->ns->parent == NULL)
+ break;
gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
- if (sym != NULL)
- {
- m = resolve_generic_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
- }
+
+ if (sym == NULL)
+ break;
+ if (!generic_sym (sym))
+ goto generic;
}
/* Last ditch attempt. */
-
+ sym = c->symtree->n.sym;
if (!gfc_generic_intrinsic (sym->name))
{
gfc_error
- ("Generic subroutine '%s' at %L is not an intrinsic subroutine",
+ ("There is no specific subroutine for the generic '%s' at %L",
sym->name, &c->loc);
return FAILURE;
}
@@ -1708,23 +1708,24 @@ resolve_specific_s (gfc_code * c)
sym = c->symtree->n.sym;
- m = resolve_specific_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
-
- gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
-
- if (sym != NULL)
+ for (;;)
{
m = resolve_specific_s0 (c, sym);
if (m == MATCH_YES)
return SUCCESS;
if (m == MATCH_ERROR)
return FAILURE;
+
+ if (sym->ns->parent == NULL)
+ break;
+
+ gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+ if (sym == NULL)
+ break;
}
+ sym = c->symtree->n.sym;
gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
sym->name, &c->loc);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b1bd217..37bf782 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1707,6 +1707,12 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
gcc_assert (rse.ss == gfc_ss_terminator);
gfc_trans_scalarizing_loops (&loop, &body);
}
+ else
+ {
+ /* Make sure that the temporary declaration survives. */
+ tmp = gfc_finish_block (&body);
+ gfc_add_expr_to_block (&loop.pre, tmp);
+ }
/* Add the post block after the second loop, so that any
freeing of allocated memory is done at the right time. */
generated by cgit v1.1 at 2025-12-27 04:18:56 +0000