From ac872468fd6f5dedd9d5a5305f56ca1e8b4c8a8a Mon Sep 17 00:00:00 2001 From: kargl Date: Tue, 29 Aug 2006 19:47:31 +0000 Subject: [PATCH] 2006-08-29 Steven G. Kargl 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 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116570 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++ gcc/fortran/match.c | 96 ++++++++++++++++++-------------- gcc/fortran/primary.c | 16 ++++-- gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/enum_5.f90 | 2 +- gcc/testsuite/gfortran.dg/pr19936_1.f90 | 2 +- gcc/testsuite/gfortran.dg/simpleif_2.f90 | 20 +++++-- 7 files changed, 96 insertions(+), 57 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a922dff..aeb3cb9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2006-08-29 Steven G. Kargl + + 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 PR fortran/28788 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index e6a7689..8a67c20 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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. */ diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index c0ed364..1428f4c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5c2b9f4..6729166 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-08-29 Steven G. Kargl + + 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 Kazu Hirata diff --git a/gcc/testsuite/gfortran.dg/enum_5.f90 b/gcc/testsuite/gfortran.dg/enum_5.f90 index 604e50d..b27aaf2 100644 --- a/gcc/testsuite/gfortran.dg/enum_5.f90 +++ b/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 "" } diff --git a/gcc/testsuite/gfortran.dg/pr19936_1.f90 b/gcc/testsuite/gfortran.dg/pr19936_1.f90 index cd5140f..516d514 100644 --- a/gcc/testsuite/gfortran.dg/pr19936_1.f90 +++ b/gcc/testsuite/gfortran.dg/pr19936_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/simpleif_2.f90 b/gcc/testsuite/gfortran.dg/simpleif_2.f90 index 0d8e6dd..ee914b2 100644 --- a/gcc/testsuite/gfortran.dg/simpleif_2.f90 +++ b/gcc/testsuite/gfortran.dg/simpleif_2.f90 @@ -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 +! 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 -- 2.7.4