diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2006-06-05 07:45:03 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2006-06-05 07:45:03 +0000 |
| commit | 6690a9e079bf15d086d2805d00fea0e228cd7db9 (patch) | |
| tree | 390b7c6a31468417e763f88ebe31b126efc05a4b /gcc/fortran/symbol.c | |
| parent | 86ad0dd600b5da40ac5c0ebd8dc230a603d3fce2 (diff) | |
| download | gcc-6690a9e079bf15d086d2805d00fea0e228cd7db9.zip gcc-6690a9e079bf15d086d2805d00fea0e228cd7db9.tar.gz gcc-6690a9e079bf15d086d2805d00fea0e228cd7db9.tar.bz2 | |
re PR fortran/14067 (no warning when character data statement overflows declared size)
2006-06-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/14067
* data.c (create_character_intializer): Add warning message
for truncated string.
PR fortran/16943
* symbol.c : Include flags.h.
(gfc_add_type): If a procedure and types are the same do not
throw an error unless standard is less than gnu or pedantic.
PR fortran/20838
* parse.c (parse_do_block): Error if named block do construct
does not have a named enddo.
PR fortran/27655
* check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
as well as target and put error return at end of function.
2006-06-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/14067
* gfortran.dg/data_char_1.f90: Add messages for truncated
strings.
PR fortran/16943
* gfortran.dg/func_decl_2.f90: New test.
PR fortran/20838
* gfortran.dg/do_2.f90: New test.
PR fortran/27655
* gfortran.dg/associated_3.f90: New test.
From-SVN: r114385
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 7acef42..63e45ec 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -23,6 +23,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "config.h" #include "system.h" +#include "flags.h" #include "gfortran.h" #include "parse.h" @@ -1178,9 +1179,18 @@ gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where) if (sym->ts.type != BT_UNKNOWN) { - gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name, - where, gfc_basic_typename (sym->ts.type)); - return FAILURE; + const char *msg = "Symbol '%s' at %L already has basic type of %s"; + if (!(sym->ts.type == ts->type + && (sym->attr.flavor == FL_PROCEDURE || sym->attr.result)) + || gfc_notification_std (GFC_STD_GNU) == ERROR + || pedantic) + { + gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type)); + return FAILURE; + } + else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where, + gfc_basic_typename (sym->ts.type)) == FAILURE) + return FAILURE; } flavor = sym->attr.flavor; |