summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog27
-rw-r--r--gcc/fortran/decl.c42
-rw-r--r--gcc/fortran/module.c2
-rw-r--r--gcc/fortran/resolve.c99
4 files changed, 126 insertions, 44 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2ead4fadebb..d7f4b6d37d5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,30 @@
+2011-08-17 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50070
+ * resolve.c (resolve_fl_variable): Reject non-constant character lengths
+ in COMMON variables.
+
+2011-08-16 Tobias Burnus <burnus@net-b.de>
+ Dominique Dhumieres <dominiq@lps.ens.fr>
+
+ PR fortran/50094
+ * resolve.c (resolve_symbol): Fix stupid typo.
+
+2011-08-15 Tobias Burnus <burnus@net-b.de>
+
+ * resolve.c (resolve_symbol): Fix coarray result-var check.
+
+2011-08-14 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ * module.c (use_iso_fortran_env_module): Spell 'referrenced' correctly.
+
+2011-08-14 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50073
+ * decl.c (check_function_name): New function, separated off from
+ 'variable_decl' and slightly extended.
+ (variable_decl,attr_decl1): Call it.
+
2011-08-08 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* Make-lang.in (gfortran$(exeext)): Add $(EXTRA_GCC_LIBS).
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 661bb14486f..18e2651c81d 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1729,6 +1729,30 @@ match_pointer_init (gfc_expr **init, int procptr)
}
+static gfc_try
+check_function_name (char *name)
+{
+ /* In functions that have a RESULT variable defined, the function name always
+ refers to function calls. Therefore, the name is not allowed to appear in
+ specification statements. When checking this, be careful about
+ 'hidden' procedure pointer results ('ppr@'). */
+
+ if (gfc_current_state () == COMP_FUNCTION)
+ {
+ gfc_symbol *block = gfc_current_block ();
+ if (block && block->result && block->result != block
+ && strcmp (block->result->name, "ppr@") != 0
+ && strcmp (block->name, name) == 0)
+ {
+ gfc_error ("Function name '%s' not allowed at %C", name);
+ return FAILURE;
+ }
+ }
+
+ return SUCCESS;
+}
+
+
/* Match a variable name with an optional initializer. When this
subroutine is called, a variable is expected to be parsed next.
Depending on what is happening at the moment, updates either the
@@ -1935,17 +1959,9 @@ variable_decl (int elem)
goto cleanup;
}
}
-
- /* In functions that have a RESULT variable defined, the function
- name always refers to function calls. Therefore, the name is
- not allowed to appear in specification statements. */
- if (gfc_current_state () == COMP_FUNCTION
- && gfc_current_block () != NULL
- && gfc_current_block ()->result != NULL
- && gfc_current_block ()->result != gfc_current_block ()
- && strcmp (gfc_current_block ()->name, name) == 0)
+
+ if (check_function_name (name) == FAILURE)
{
- gfc_error ("Function name '%s' not allowed at %C", name);
m = MATCH_ERROR;
goto cleanup;
}
@@ -5995,6 +6011,12 @@ attr_decl1 (void)
if (find_special (name, &sym, false))
return MATCH_ERROR;
+ if (check_function_name (name) == FAILURE)
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+
var_locus = gfc_current_locus;
/* Deal with possible array specification for certain attributes. */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index b62ad8d08e0..aef340464c5 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5577,7 +5577,7 @@ use_iso_fortran_env_module (void)
u->found = 1;
if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
- "referrenced at %C, is not in the selected "
+ "referenced at %C, is not in the selected "
"standard", symbol[i].name) == FAILURE)
continue;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6245666f620..7557ab8891d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10169,15 +10169,22 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
if (!gfc_is_constant_expr (e)
&& !(e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.flavor == FL_PARAMETER)
- && sym->ns->proc_name
- && (sym->ns->proc_name->attr.flavor == FL_MODULE
- || sym->ns->proc_name->attr.is_main_program)
- && !sym->attr.use_assoc)
- {
- gfc_error ("'%s' at %L must have constant character length "
- "in this context", sym->name, &sym->declared_at);
- return FAILURE;
+ && e->symtree->n.sym->attr.flavor == FL_PARAMETER))
+ {
+ if (!sym->attr.use_assoc && sym->ns->proc_name
+ && (sym->ns->proc_name->attr.flavor == FL_MODULE
+ || sym->ns->proc_name->attr.is_main_program))
+ {
+ gfc_error ("'%s' at %L must have constant character length "
+ "in this context", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+ if (sym->attr.in_common)
+ {
+ gfc_error ("COMMON variable '%s' at %L must have constant "
+ "character length", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
}
}
@@ -12246,29 +12253,41 @@ resolve_symbol (gfc_symbol *sym)
/* F2008, C542. */
if (sym->ts.type == BT_DERIVED && sym->attr.dummy
&& sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
- gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be "
- "INTENT(OUT)", sym->name, &sym->declared_at);
+ {
+ gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be "
+ "INTENT(OUT)", sym->name, &sym->declared_at);
+ return;
+ }
- /* F2008, C526. */
+ /* F2008, C525. */
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| sym->attr.codimension)
- && sym->attr.result)
- gfc_error ("Function result '%s' at %L shall not be a coarray or have "
- "a coarray component", sym->name, &sym->declared_at);
+ && (sym->attr.result || sym->result == sym))
+ {
+ gfc_error ("Function result '%s' at %L shall not be a coarray or have "
+ "a coarray component", sym->name, &sym->declared_at);
+ return;
+ }
/* F2008, C524. */
if (sym->attr.codimension && sym->ts.type == BT_DERIVED
&& sym->ts.u.derived->ts.is_iso_c)
- gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
- "shall not be a coarray", sym->name, &sym->declared_at);
+ {
+ gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+ "shall not be a coarray", sym->name, &sym->declared_at);
+ return;
+ }
/* F2008, C525. */
if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp
&& (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension
|| sym->attr.allocatable))
- gfc_error ("Variable '%s' at %L with coarray component "
- "shall be a nonpointer, nonallocatable scalar",
- sym->name, &sym->declared_at);
+ {
+ gfc_error ("Variable '%s' at %L with coarray component "
+ "shall be a nonpointer, nonallocatable scalar",
+ sym->name, &sym->declared_at);
+ return;
+ }
/* F2008, C526. The function-result case was handled above. */
if (sym->attr.codimension
@@ -12277,32 +12296,46 @@ resolve_symbol (gfc_symbol *sym)
|| sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program
|| sym->attr.function || sym->attr.result || sym->attr.use_assoc))
- gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE "
- "nor a dummy argument", sym->name, &sym->declared_at);
+ {
+ gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE "
+ "nor a dummy argument", sym->name, &sym->declared_at);
+ return;
+ }
/* F2008, C528. */ /* FIXME: sym->as check due to PR 43412. */
else if (sym->attr.codimension && !sym->attr.allocatable
&& sym->as && sym->as->cotype == AS_DEFERRED)
- gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
- "deferred shape", sym->name, &sym->declared_at);
+ {
+ gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
+ "deferred shape", sym->name, &sym->declared_at);
+ return;
+ }
else if (sym->attr.codimension && sym->attr.allocatable
&& (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
- gfc_error ("Allocatable coarray variable '%s' at %L must have "
- "deferred shape", sym->name, &sym->declared_at);
-
+ {
+ gfc_error ("Allocatable coarray variable '%s' at %L must have "
+ "deferred shape", sym->name, &sym->declared_at);
+ return;
+ }
/* F2008, C541. */
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| (sym->attr.codimension && sym->attr.allocatable))
&& sym->attr.dummy && sym->attr.intent == INTENT_OUT)
- gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
- "allocatable coarray or have coarray components",
- sym->name, &sym->declared_at);
+ {
+ gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
+ "allocatable coarray or have coarray components",
+ sym->name, &sym->declared_at);
+ return;
+ }
if (sym->attr.codimension && sym->attr.dummy
&& sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
- gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
- "procedure '%s'", sym->name, &sym->declared_at,
- sym->ns->proc_name->name);
+ {
+ gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
+ "procedure '%s'", sym->name, &sym->declared_at,
+ sym->ns->proc_name->name);
+ return;
+ }
switch (sym->attr.flavor)
{
View Lorry Controller Status