Skip to content

R
riscv-gcc-1
Commit 5056a350 by Steven G. Kargl Committed by Steven G. Kargl
Options

re PR fortran/28866 (Simple if statements are not so simple) 

2006-08-29  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/28866
	* match.c: Wrap copyright.
	(gfc_match_assignment):  Return MATCH_NO for failed lvalue.  Remove
	gotos.  Move error handling of FL_PARAMETER to ...
 	* gfc_match_if: Deal with MATCH_NO from above.
	* primary.c: Wrap copyright.
	(match_variable): ... here.  Improve error messages.


2006-08-29  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/28866
	* gfortran.dg/simpleif_2.f90: New test.
	* gfortran.dg/pr19936_1.f90: Adjust dg-error message.
	* gfortran.dg/enum_5.f90: Ditto.

From-SVN: r116570
parent e370818b
Showing with 96 additions and 57 deletions
gcc/fortran/ChangeLog
2006-08-29 Steven G. Kargl <kargls@comcast.net>
PR fortran/28866
* match.c: Wrap copyright.
(gfc_match_assignment): Return MATCH_NO for failed lvalue. Remove
gotos. Move error handling of FL_PARAMETER to ...
* gfc_match_if: Deal with MATCH_NO from above.
* primary.c: Wrap copyright.
(match_variable): ... here. Improve error messages.
2006-08-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28788
......
gcc/fortran/match.c
/* Matching subroutines in all sizes, shapes and colors.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
......@@ -843,21 +843,24 @@ gfc_match_assignment (void)
old_loc = gfc_current_locus;
lvalue = rvalue = NULL;
lvalue = NULL;
m = gfc_match (" %v =", &lvalue);
if (m != MATCH_YES)
goto cleanup;
if (lvalue->symtree->n.sym->attr.flavor == FL_PARAMETER)
{
gfc_error ("Cannot assign to a PARAMETER variable at %C");
m = MATCH_ERROR;
goto cleanup;
gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
return MATCH_NO;
}
rvalue = NULL;
m = gfc_match (" %e%t", &rvalue);
if (m != MATCH_YES)
goto cleanup;
{
gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
gfc_free_expr (rvalue);
return m;
}
gfc_set_sym_referenced (lvalue->symtree->n.sym);
......@@ -868,12 +871,6 @@ gfc_match_assignment (void)
gfc_check_do_variable (lvalue->symtree);
return MATCH_YES;
cleanup:
gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
gfc_free_expr (rvalue);
return m;
}
......@@ -1061,9 +1058,9 @@ gfc_match_if (gfc_statement * if_type)
gfc_undo_symbols ();
gfc_current_locus = old_loc;
/* m can be MATCH_NO or MATCH_ERROR, here. For MATCH_NO, continue to
call the various matchers. For MATCH_ERROR, a mangled assignment
was found. */
/* m can be MATCH_NO or MATCH_ERROR, here. For MATCH_ERROR, a mangled
assignment was found. For MATCH_NO, continue to call the various
matchers. */
if (m == MATCH_ERROR)
return MATCH_ERROR;
......@@ -1089,30 +1086,43 @@ gfc_match_if (gfc_statement * if_type)
gfc_clear_error ();
match ("allocate", gfc_match_allocate, ST_ALLOCATE)
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
match ("backspace", gfc_match_backspace, ST_BACKSPACE)
match ("call", gfc_match_call, ST_CALL)
match ("close", gfc_match_close, ST_CLOSE)
match ("continue", gfc_match_continue, ST_CONTINUE)
match ("cycle", gfc_match_cycle, ST_CYCLE)
match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
match ("end file", gfc_match_endfile, ST_END_FILE)
match ("exit", gfc_match_exit, ST_EXIT)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
match ("inquire", gfc_match_inquire, ST_INQUIRE)
match ("nullify", gfc_match_nullify, ST_NULLIFY)
match ("open", gfc_match_open, ST_OPEN)
match ("pause", gfc_match_pause, ST_NONE)
match ("print", gfc_match_print, ST_WRITE)
match ("read", gfc_match_read, ST_READ)
match ("return", gfc_match_return, ST_RETURN)
match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP)
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
match ("backspace", gfc_match_backspace, ST_BACKSPACE)
match ("call", gfc_match_call, ST_CALL)
match ("close", gfc_match_close, ST_CLOSE)
match ("continue", gfc_match_continue, ST_CONTINUE)
match ("cycle", gfc_match_cycle, ST_CYCLE)
match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
match ("end file", gfc_match_endfile, ST_END_FILE)
match ("exit", gfc_match_exit, ST_EXIT)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
match ("inquire", gfc_match_inquire, ST_INQUIRE)
match ("nullify", gfc_match_nullify, ST_NULLIFY)
match ("open", gfc_match_open, ST_OPEN)
match ("pause", gfc_match_pause, ST_NONE)
match ("print", gfc_match_print, ST_WRITE)
match ("read", gfc_match_read, ST_READ)
match ("return", gfc_match_return, ST_RETURN)
match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP)
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
/* The gfc_match_assignment() above may have returned a MATCH_NO
where the assignement was to a named constant. Check that
special case here. */
m = gfc_match_assignment ();
if (m == MATCH_NO)
{
gfc_error ("Cannot assign to a named constant at %C");
gfc_free_expr (expr);
gfc_undo_symbols ();
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
/* All else has failed, so give up. See if any of the matchers has
stored an error message of some sort. */
......
gcc/fortran/primary.c
/* Primary expression subroutines
Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
......@@ -2295,16 +2295,20 @@ match_variable (gfc_expr ** result, int equiv_flag, int host_flag)
case FL_VARIABLE:
break;
case FL_PROGRAM:
return MATCH_NO;
break;
case FL_UNKNOWN:
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
sym->name, NULL) == FAILURE)
return MATCH_ERROR;
break;
case FL_PARAMETER:
if (equiv_flag)
gfc_error ("Named constant at %C in an EQUIVALENCE");
else
gfc_error ("Cannot assign to a named constant at %C");
return MATCH_ERROR;
break;
case FL_PROCEDURE:
/* Check for a nonrecursive function result */
if (sym->attr.function && (sym->result == sym || sym->attr.entry))
......
gcc/testsuite/ChangeLog
2006-08-29 Steven G. Kargl <kargls@comcast.net>
PR fortran/28866
* gfortran.dg/simpleif_2.f90: New test.
* gfortran.dg/pr19936_1.f90: Adjust dg-error message.
* gfortran.dg/enum_5.f90: Ditto.
2006-08-29 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
Kazu Hirata <kazu@codesourcery.com>
gcc/testsuite/gfortran.dg/enum_5.f90
......@@ -10,6 +10,6 @@ program main
enumerator :: blue = 1
end enum junk ! { dg-error "Syntax error" }
blue = 10 ! { dg-error "Expected VARIABLE" }
blue = 10 ! { dg-error " assign to a named constant" }
end program main ! { dg-excess-errors "" }
gcc/testsuite/gfortran.dg/pr19936_1.f90
! { dg-do compile }
program pr19936_1
integer, parameter :: i=4
print *,(/(i,i=1,4)/) ! { dg-error "Expected VARIABLE" }
print *,(/(i,i=1,4)/) ! { dg-error "assign to a named constant" }
end program pr19936_1
gcc/testsuite/gfortran.dg/simpleif_2.f90
! { dg-do compile }
! PR 27981
program a
real x
real, pointer :: y
if (.true.) x = 12345678901 ! { dg-error "Integer too big" }
end program a
! Test fix for regression caused by
! 2006-06-23 Steven G. Kargl <kargls@comcast.net>
! PR fortran/27981
! * match.c (gfc_match_if): Handle errors in assignment in simple if.
!
module read
integer i, j, k
contains
subroutine a
integer, parameter :: n = 2
if (i .eq. 0) read(j,*) k
if (i .eq. 0) n = j ! { dg-error "assign to a named constant" "" }
end subroutine a
end module read
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