diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2016-09-22 07:46:07 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2016-09-22 07:46:07 +0000 |
| commit | a8de3002f19eb09cf95d36f1a97e30f234df7d9e (patch) | |
| tree | 20c8a2260ebf12f29bf9cbce0b762dbf8b19f6dc /gcc/fortran/interface.c | |
| parent | 39abef62a17740d59f4bab506c07867cffa7da10 (diff) | |
| download | gcc-a8de3002f19eb09cf95d36f1a97e30f234df7d9e.zip gcc-a8de3002f19eb09cf95d36f1a97e30f234df7d9e.tar.gz gcc-a8de3002f19eb09cf95d36f1a97e30f234df7d9e.tar.bz2 | |
interface.c (check_dtio_interface1): Introduce errors for alternate returns and incorrect numbers of arguments.
2016-09-22 Paul Thomas <pault@gcc.gnu.org>
* interface.c (check_dtio_interface1): Introduce errors for
alternate returns and incorrect numbers of arguments.
(gfc_find_specific_dtio_proc): Return cleanly if the derived
type either doesn't exist or has no namespace.
2016-09-22 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/dtio_11.f90: Correct for changed error messages.
* gfortran.dg/dtio_13.f90: New test.
From-SVN: r240342
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 40 |
1 files changed, 38 insertions, 2 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f8a4edb..09f5a53 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -4629,7 +4629,7 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next) { - if (intr->sym && intr->sym->formal + if (intr->sym && intr->sym->formal && intr->sym->formal->sym && ((intr->sym->formal->sym->ts.type == BT_CLASS && CLASS_DATA (intr->sym->formal->sym)->ts.u.derived == derived) @@ -4639,6 +4639,12 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, dtio_sub = intr->sym; break; } + else if (intr->sym && intr->sym->formal && !intr->sym->formal->sym) + { + gfc_error ("Alternate return at %L is not permitted in a DTIO " + "procedure", &intr->sym->declared_at); + return; + } } if (dtio_sub == NULL) @@ -4647,9 +4653,28 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, gcc_assert (dtio_sub); if (!dtio_sub->attr.subroutine) - gfc_error ("DTIO procedure %s at %L must be a subroutine", + gfc_error ("DTIO procedure '%s' at %L must be a subroutine", dtio_sub->name, &dtio_sub->declared_at); + arg_num = 0; + for (formal = dtio_sub->formal; formal; formal = formal->next) + arg_num++; + + if (arg_num < (formatted ? 6 : 4)) + { + gfc_error ("Too few dummy arguments in DTIO procedure '%s' at %L", + dtio_sub->name, &dtio_sub->declared_at); + return; + } + + if (arg_num > (formatted ? 6 : 4)) + { + gfc_error ("Too many dummy arguments in DTIO procedure '%s' at %L", + dtio_sub->name, &dtio_sub->declared_at); + return; + } + + /* Now go through the formal arglist. */ arg_num = 1; for (formal = dtio_sub->formal; formal; formal = formal->next, arg_num++) @@ -4657,6 +4682,14 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, if (!formatted && arg_num == 3) arg_num = 5; fsym = formal->sym; + + if (fsym == NULL) + { + gfc_error ("Alternate return at %L is not permitted in a DTIO " + "procedure", &dtio_sub->declared_at); + return; + } + switch (arg_num) { case(1): /* DTV */ @@ -4823,6 +4856,9 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted) for (extended = derived; extended; extended = gfc_get_derived_super_type (extended)) { + if (extended == NULL || extended->ns == NULL) + return NULL; + if (formatted == true) { if (write == true) |