Commit 79e7840d by Jerry DeLisle

re PR fortran/31162 (missing warning for real do-loops with implicit typed variables)

2007-06-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/31162
	* resolve.c (gfc_resolve_iterator_expr): Add check for REAL using
	gfc_notify_standard. (gfc_resolve_iterator): Remove check.
	(resolve_branch): Change "Obsolete" to "Deleted feature".
	* io.c (resolve_tag): Ditto.
	* match.c (gfc_match_pause, gfc_match_assign, gfc_match_goto): Ditto.

From-SVN: r125938
parent 49d2bde8
2007-06-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/31162
* resolve.c (gfc_resolve_iterator_expr): Add check for REAL using
gfc_notify_standard. (gfc_resolve_iterator): Remove check.
(resolve_branch): Change "Obsolete" to "Deleted feature".
* io.c (resolve_tag): Ditto.
* match.c (gfc_match_pause, gfc_match_assign, gfc_match_goto): Ditto.
2007-06-20 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2007-06-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/32361 PR fortran/32361
......
...@@ -1072,7 +1072,7 @@ resolve_tag (const io_tag *tag, gfc_expr *e) ...@@ -1072,7 +1072,7 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
} }
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE) else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
{ {
if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: ASSIGNED " if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED "
"variable in FORMAT tag at %L", &e->where) "variable in FORMAT tag at %L", &e->where)
== FAILURE) == FAILURE)
return FAILURE; return FAILURE;
......
...@@ -1578,7 +1578,8 @@ gfc_match_pause (void) ...@@ -1578,7 +1578,8 @@ gfc_match_pause (void)
m = gfc_match_stopcode (ST_PAUSE); m = gfc_match_stopcode (ST_PAUSE);
if (m == MATCH_YES) if (m == MATCH_YES)
{ {
if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: PAUSE statement at %C") if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: PAUSE statement"
" at %C")
== FAILURE) == FAILURE)
m = MATCH_ERROR; m = MATCH_ERROR;
} }
...@@ -1625,7 +1626,7 @@ gfc_match_assign (void) ...@@ -1625,7 +1626,7 @@ gfc_match_assign (void)
return MATCH_ERROR; return MATCH_ERROR;
if (gfc_match (" to %v%t", &expr) == MATCH_YES) if (gfc_match (" to %v%t", &expr) == MATCH_YES)
{ {
if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: ASSIGN " if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGN "
"statement at %C") "statement at %C")
== FAILURE) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
...@@ -1671,7 +1672,7 @@ gfc_match_goto (void) ...@@ -1671,7 +1672,7 @@ gfc_match_goto (void)
if (gfc_match_variable (&expr, 0) == MATCH_YES) if (gfc_match_variable (&expr, 0) == MATCH_YES)
{ {
if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: Assigned GOTO " if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: Assigned GOTO "
"statement at %C") "statement at %C")
== FAILURE) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
......
...@@ -3373,15 +3373,26 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, ...@@ -3373,15 +3373,26 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok,
return FAILURE; return FAILURE;
} }
if (!(expr->ts.type == BT_INTEGER if (expr->ts.type != BT_INTEGER)
|| (expr->ts.type == BT_REAL && real_ok)))
{ {
if (real_ok) if (expr->ts.type == BT_REAL)
gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid), {
&expr->where); if (real_ok)
return gfc_notify_std (GFC_STD_F95_DEL,
"Deleted feature: %s at %L must be integer",
_(name_msgid), &expr->where);
else
{
gfc_error ("%s at %L must be INTEGER", _(name_msgid),
&expr->where);
return FAILURE;
}
}
else else
gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); {
return FAILURE; gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
return FAILURE;
}
} }
return SUCCESS; return SUCCESS;
} }
...@@ -3393,11 +3404,6 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, ...@@ -3393,11 +3404,6 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok,
try try
gfc_resolve_iterator (gfc_iterator *iter, bool real_ok) gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
{ {
if (iter->var->ts.type == BT_REAL)
gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: REAL DO loop iterator at %L",
&iter->var->where);
if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable") if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable")
== FAILURE) == FAILURE)
return FAILURE; return FAILURE;
...@@ -4572,7 +4578,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) ...@@ -4572,7 +4578,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
if (stack && stack->current->next->op == EXEC_NOP) if (stack && stack->current->next->op == EXEC_NOP)
{ {
gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps to " gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps to "
"END of construct at %L", &code->loc, "END of construct at %L", &code->loc,
&stack->current->next->loc); &stack->current->next->loc);
return; /* We know this is not an END DO. */ return; /* We know this is not an END DO. */
...@@ -4586,7 +4592,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) ...@@ -4586,7 +4592,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
|| stack->current->op == EXEC_DO_WHILE) || stack->current->op == EXEC_DO_WHILE)
&& stack->tail->here == label && stack->tail->op == EXEC_NOP) && stack->tail->here == label && stack->tail->op == EXEC_NOP)
{ {
gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps " gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps "
"to END of construct at %L", &code->loc, "to END of construct at %L", &code->loc,
&stack->tail->loc); &stack->tail->loc);
return; return;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment