OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Steven G. Kargl 2006-08-29 19:47:31 +00:00 committed by Steven G. Kargl
parent e370818b21
commit 5056a35047
7 changed files with 96 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
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

96
gcc/fortran/match.c
View File

@ -1,6 +1,6 @@
/* 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. */

16
gcc/fortran/primary.c
View File

@ -1,6 +1,6 @@
/* 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))

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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>

2
gcc/testsuite/gfortran.dg/enum_5.f90
View File

@ -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 "" }

2
gcc/testsuite/gfortran.dg/pr19936_1.f90
View File

@ -1,5 +1,5 @@
! { 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

20
gcc/testsuite/gfortran.dg/simpleif_2.f90
View File

@ -1,7 +1,15 @@
! { 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