From: Paul Thomas Date: Wed, 5 Aug 2015 12:06:25 +0000 (+0000) Subject: re PR fortran/52846 ([F2008] Support submodules) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a56ea54ab05e657c9a140b0e14d6a7e576aa58c2;p=gcc.git re PR fortran/52846 ([F2008] Support submodules) 2015-08-05 Paul Thomas PR fortran/52846 * module.c (check_access): Return true if new static flag 'dump_smod' is true.. (gfc_dump_module): Rename original 'dump_module' and call from new version. Use 'dump_smod' rather than the stack state to determine if a submodule is being processed. The new version of this procedure sets 'dump_smod' depending on the stack state and then writes both the mod and smod files if a module is being processed or just the smod for a submodule. (gfc_use_module): Eliminate the check for module_name and submodule_name being the same. * trans-decl.c (gfc_finish_var_decl, gfc_build_qualified_array, get_proc_pointer_decl): Set TREE_PUBLIC unconditionally and use the conditions to set DECL_VISIBILITY as hidden and to set as true DECL_VISIBILITY_SPECIFIED. 2015-08-05 Paul Thomas PR fortran/52846 * lib/fortran-modules.exp: Call cleanup-submodules from cleanup-modules. * gfortran.dg/public_private_module_2.f90: Add two XFAILS to cover the cases where private entities are no longer optimized away. * gfortran.dg/public_private_module_6.f90: Add an XFAIL for the same reason. * gfortran.dg/submodule_1.f08: Change cleanup module names. * gfortran.dg/submodule_5.f08: The same. * gfortran.dg/submodule_9.f08: The same. * gfortran.dg/submodule_10.f08: New test From-SVN: r226622 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 46f9a927938..008d3bd1c05 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2015-08-05 Paul Thomas + + PR fortran/52846 + * module.c (check_access): Return true if new static flag + 'dump_smod' is true.. + (gfc_dump_module): Rename original 'dump_module' and call from + new version. Use 'dump_smod' rather than the stack state to + determine if a submodule is being processed. The new version of + this procedure sets 'dump_smod' depending on the stack state and + then writes both the mod and smod files if a module is being + processed or just the smod for a submodule. + (gfc_use_module): Eliminate the check for module_name and + submodule_name being the same. + * trans-decl.c (gfc_finish_var_decl, gfc_build_qualified_array, + get_proc_pointer_decl): Set TREE_PUBLIC unconditionally and use + the conditions to set DECL_VISIBILITY as hidden and to set as + true DECL_VISIBILITY_SPECIFIED. + 2015-08-04 Francois-Xavier Coudert PR fortran/64022 diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index db1d3392811..86dca1c5382 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -525,9 +525,9 @@ gfc_match_use (void) gfc_intrinsic_op op; match m; gfc_use_list *use_list; - + use_list = gfc_get_use_list (); - + if (gfc_match (" , ") == MATCH_YES) { if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) @@ -1080,7 +1080,7 @@ gzopen_included_file_1 (const char *name, gfc_directorylist *list, return NULL; } -static gzFile +static gzFile gzopen_included_file (const char *name, bool include_cwd, bool module) { gzFile f = NULL; @@ -1660,7 +1660,7 @@ write_atom (atom_type atom, const void *v) } - if(p == NULL || *p == '\0') + if(p == NULL || *p == '\0') len = 0; else len = strlen (p); @@ -1856,7 +1856,7 @@ unquote_string (const char *s) { if (*p != '\\') continue; - + if (p[1] == '\\') p++; else if (p[1] == 'U') @@ -2106,7 +2106,7 @@ mio_symbol_attribute (symbol_attribute *attr) attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures); attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types); attr->save = MIO_NAME (save_state) (attr->save, save_status); - + ext_attr = attr->ext_attr; mio_integer ((int *) &ext_attr); attr->ext_attr = ext_attr; @@ -2472,7 +2472,7 @@ mio_typespec (gfc_typespec *ts) /* Add info for C interop and is_iso_c. */ mio_integer (&ts->is_c_interop); mio_integer (&ts->is_iso_c); - + /* If the typespec is for an identifier either from iso_c_binding, or a constant that was initialized to an identifier from it, use the f90_type. Otherwise, use the ts->type, since it shouldn't matter. */ @@ -2725,7 +2725,7 @@ mio_component (gfc_component *c, int vtype) mio_symbol_attribute (&c->attr); if (c->ts.type == BT_CLASS) c->attr.class_ok = 1; - c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); + c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); if (!vtype || strcmp (c->name, "_final") == 0 || strcmp (c->name, "_hash") == 0) @@ -2925,7 +2925,7 @@ mio_symtree_ref (gfc_symtree **stp) resolve_fixups (p->fixup, p->u.rsym.sym); p->fixup = NULL; } - + if (p->type == P_UNKNOWN) p->type = P_SYMBOL; @@ -3260,7 +3260,7 @@ static const mstring intrinsics[] = /* Remedy a couple of situations where the gfc_expr's can be defective. */ - + static void fix_mio_expr (gfc_expr *e) { @@ -3830,7 +3830,7 @@ mio_full_typebound_tree (gfc_symtree** root) { gfc_symtree* st; - mio_lparen (); + mio_lparen (); require_atom (ATOM_STRING); st = gfc_get_tbp_symtree (root, atom_string); @@ -3931,7 +3931,7 @@ static void mio_full_f2k_derived (gfc_symbol *sym) { mio_lparen (); - + if (iomode == IO_OUTPUT) { if (sym->f2k_derived) @@ -4158,7 +4158,7 @@ static void mio_symbol (gfc_symbol *sym) { int intmod = INTMOD_NONE; - + mio_lparen (); mio_symbol_attribute (&sym->attr); @@ -4219,7 +4219,7 @@ mio_symbol (gfc_symbol *sym) else sym->from_intmod = (intmod_id) intmod; } - + mio_integer (&(sym->intmod_sym_id)); if (sym->attr.flavor == FL_DERIVED) @@ -4559,7 +4559,7 @@ load_commons (void) if (strlen (label)) p->binding_label = IDENTIFIER_POINTER (get_identifier (label)); XDELETEVEC (label); - + mio_rparen (); } @@ -4805,7 +4805,7 @@ load_needed (pointer_info *p) sym->name = dt_lower_string (p->u.rsym.true_name); sym->module = gfc_get_string (p->u.rsym.module); if (p->u.rsym.binding_label) - sym->binding_label = IDENTIFIER_POINTER (get_identifier + sym->binding_label = IDENTIFIER_POINTER (get_identifier (p->u.rsym.binding_label)); associate_integer_pointer (p, sym); @@ -4989,7 +4989,7 @@ read_module (void) info->u.rsym.binding_label = bind_label; else XDELETEVEC (bind_label); - + require_atom (ATOM_INTEGER); info->u.rsym.ns = atom_int; @@ -5165,8 +5165,8 @@ read_module (void) sym->module = gfc_get_string (info->u.rsym.module); if (info->u.rsym.binding_label) - sym->binding_label = - IDENTIFIER_POINTER (get_identifier + sym->binding_label = + IDENTIFIER_POINTER (get_identifier (info->u.rsym.binding_label)); } @@ -5279,13 +5279,18 @@ read_module (void) /* Given an access type that is specific to an entity and the default access, return nonzero if the entity is publicly accessible. If the - element is declared as PUBLIC, then it is public; if declared + element is declared as PUBLIC, then it is public; if declared PRIVATE, then private, and otherwise it is public unless the default access in this context has been declared PRIVATE. */ +static bool dump_smod = false; + static bool check_access (gfc_access specific_access, gfc_access default_access) { + if (dump_smod) + return true; + if (specific_access == ACCESS_PUBLIC) return TRUE; if (specific_access == ACCESS_PRIVATE) @@ -5359,7 +5364,7 @@ write_common_0 (gfc_symtree *st, bool this_module) const char *label; struct written_common *w; bool write_me = true; - + if (st == NULL) return; @@ -5436,8 +5441,8 @@ write_blank_common (void) const char * name = BLANK_COMMON_NAME; int saved; /* TODO: Blank commons are not bind(c). The F2003 standard probably says - this, but it hasn't been checked. Just making it so for now. */ - int is_bind_c = 0; + this, but it hasn't been checked. Just making it so for now. */ + int is_bind_c = 0; if (gfc_current_ns->blank_common.head == NULL) return; @@ -5697,8 +5702,8 @@ find_symbols_to_write(sorted_pointer_info **tree, pointer_info *p) if (p->type == P_SYMBOL && p->u.wsym.state == NEEDS_WRITE) { sorted_pointer_info *sp = gfc_get_sorted_pointer_info(); - sp->p = p; - + sp->p = p; + gfc_insert_bbt (tree, sp, compare_sorted_pointer_info); } @@ -5724,7 +5729,7 @@ write_symbol1_recursion (sorted_pointer_info *sp) p1->u.wsym.state = WRITTEN; write_symbol (p1->integer, p1->u.wsym.sym); p1->u.wsym.sym->attr.public_used = 1; - + write_symbol1_recursion (sp->right); } @@ -5945,10 +5950,10 @@ read_crc32_from_module_file (const char* filename, uLong* crc) /* Close the file. */ fclose (file); - val = (buf[0] & 0xFF) + ((buf[1] & 0xFF) << 8) + ((buf[2] & 0xFF) << 16) + val = (buf[0] & 0xFF) + ((buf[1] & 0xFF) << 8) + ((buf[2] & 0xFF) << 16) + ((buf[3] & 0xFF) << 24); *crc = val; - + /* For debugging, the CRC value printed in hexadecimal should match the CRC printed by "zcat -l -v filename". printf("CRC of file %s is %x\n", filename, val); */ @@ -5961,8 +5966,8 @@ read_crc32_from_module_file (const char* filename, uLong* crc) processing the module, dump_flag will be set to zero and we delete the module file, even if it was already there. */ -void -gfc_dump_module (const char *name, int dump_flag) +static void +dump_module (const char *name, int dump_flag) { int n; char *filename, *filename_tmp; @@ -5970,13 +5975,13 @@ gfc_dump_module (const char *name, int dump_flag) module_name = gfc_get_string (name); - if (gfc_state_stack->state == COMP_SUBMODULE) + if (dump_smod) { name = submodule_name; n = strlen (name) + strlen (SUBMODULE_EXTENSION) + 1; } else - n = strlen (name) + strlen (MODULE_EXTENSION) + 1; + n = strlen (name) + strlen (MODULE_EXTENSION) + 1; if (gfc_option.module_dir != NULL) { @@ -5991,7 +5996,7 @@ gfc_dump_module (const char *name, int dump_flag) strcpy (filename, name); } - if (gfc_state_stack->state == COMP_SUBMODULE) + if (dump_smod) strcat (filename, SUBMODULE_EXTENSION); else strcat (filename, MODULE_EXTENSION); @@ -6060,6 +6065,27 @@ gfc_dump_module (const char *name, int dump_flag) } +void +gfc_dump_module (const char *name, int dump_flag) +{ + if (gfc_state_stack->state == COMP_SUBMODULE) + dump_smod = true; + else + dump_smod =false; + + dump_module (name, dump_flag); + + if (dump_smod) + return; + + /* Write a submodule file from a module. The 'dump_smod' flag switches + off the check for PRIVATE entities. */ + dump_smod = true; + submodule_name = module_name; + dump_module (name, dump_flag); + dump_smod = false; +} + static void create_intrinsic_function (const char *name, int id, const char *modname, intmod_id module, @@ -6140,7 +6166,7 @@ import_iso_c_binding_module (void) /* symtree doesn't already exist in current namespace. */ gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree, false); - + if (mod_symtree != NULL) mod_sym = mod_symtree->n.sym; else @@ -6452,7 +6478,7 @@ create_int_parameter_array (const char *name, int size, gfc_expr *value, sym->as->rank = 1; sym->as->type = AS_EXPLICIT; sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); - sym->as->upper[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, size); + sym->as->upper[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, size); sym->value = value; sym->value->shape = gfc_get_shape (1); @@ -6754,13 +6780,12 @@ gfc_use_module (gfc_use_list *module) "USE statement at %C has no ONLY qualifier"); if (gfc_state_stack->state == COMP_MODULE - || module->submodule_name == NULL - || strcmp (module_name, module->submodule_name) == 0) + || module->submodule_name == NULL) { filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION) + 1); - strcpy (filename, module_name); - strcat (filename, MODULE_EXTENSION); + strcpy (filename, module_name); + strcat (filename, MODULE_EXTENSION); } else { @@ -7003,7 +7028,7 @@ gfc_use_modules (void) r->next = next->rename; next->rename = seek->rename; } - last->next = seek->next; + last->next = seek->next; free (seek); } else diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f95ca167c2f..269c235e465 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -596,6 +596,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) both, of course.) (J3/04-007, section 15.3). */ TREE_PUBLIC(decl) = 1; DECL_COMMON(decl) = 1; + if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used) + { + DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN; + DECL_VISIBILITY_SPECIFIED (decl) = true; + } } /* If a variable is USE associated, it's always external. */ @@ -609,9 +614,13 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) /* TODO: Don't set sym->module for result or dummy variables. */ gcc_assert (current_function_decl == NULL_TREE || sym->result == sym); - if (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used) - TREE_PUBLIC (decl) = 1; + TREE_PUBLIC (decl) = 1; TREE_STATIC (decl) = 1; + if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used) + { + DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN; + DECL_VISIBILITY_SPECIFIED (decl) = true; + } } /* Derived types are a bit peculiar because of the possibility of @@ -837,9 +846,13 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) else TREE_STATIC (token) = 1; - if (sym->attr.use_assoc || sym->attr.access != ACCESS_PRIVATE || - sym->attr.public_used) - TREE_PUBLIC (token) = 1; + TREE_PUBLIC (token) = 1; + + if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used) + { + DECL_VISIBILITY (token) = VISIBILITY_HIDDEN; + DECL_VISIBILITY_SPECIFIED (token) = true; + } } else { @@ -1747,9 +1760,12 @@ get_proc_pointer_decl (gfc_symbol *sym) else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE) { /* This is the declaration of a module variable. */ - if (sym->ns->proc_name->attr.flavor == FL_MODULE - && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used)) - TREE_PUBLIC (decl) = 1; + TREE_PUBLIC (decl) = 1; + if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used) + { + DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN; + DECL_VISIBILITY_SPECIFIED (decl) = true; + } TREE_STATIC (decl) = 1; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index aab1f851bb7..d1bb135d8bb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,19 @@ +2015-08-05 Paul Thomas + + PR fortran/52846 + + * lib/fortran-modules.exp: Call cleanup-submodules from + cleanup-modules. + * gfortran.dg/public_private_module_2.f90: Add two XFAILS to + cover the cases where private entities are no longer optimized + away. + * gfortran.dg/public_private_module_6.f90: Add an XFAIL for the + same reason. + * gfortran.dg/submodule_1.f08: Change cleanup module names. + * gfortran.dg/submodule_5.f08: The same. + * gfortran.dg/submodule_9.f08: The same. + * gfortran.dg/submodule_10.f08: New test. + 2015-08-05 Paolo Carlini PR c++/66595 diff --git a/gcc/testsuite/gfortran.dg/public_private_module_2.f90 b/gcc/testsuite/gfortran.dg/public_private_module_2.f90 index aa6b9fc7268..4c72b2cb55d 100644 --- a/gcc/testsuite/gfortran.dg/public_private_module_2.f90 +++ b/gcc/testsuite/gfortran.dg/public_private_module_2.f90 @@ -18,12 +18,15 @@ integer, bind(C,name='') :: qq end module mod +! The two xfails below have appeared with the introduction of submodules. 'iii' and +! 'mmm' now are TREE_PUBLIC but has DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN set. + ! { dg-final { scan-assembler "__mod_MOD_aa" } } - ! { dg-final { scan-assembler-not "iii" } } + ! { dg-final { scan-assembler-not "iii" { xfail *-*-* } } } ! { dg-final { scan-assembler "jj" } } ! { dg-final { scan-assembler "lll" } } ! { dg-final { scan-assembler-not "kk" } } - ! { dg-final { scan-assembler-not "mmmm" } } + ! { dg-final { scan-assembler-not "mmmm" { xfail *-*-* } } } ! { dg-final { scan-assembler "nnn" } } ! { dg-final { scan-assembler "oo" } } ! { dg-final { scan-assembler "__mod_MOD_qq" } } diff --git a/gcc/testsuite/gfortran.dg/public_private_module_6.f90 b/gcc/testsuite/gfortran.dg/public_private_module_6.f90 index 85d6930d3d8..75b1a972c23 100644 --- a/gcc/testsuite/gfortran.dg/public_private_module_6.f90 +++ b/gcc/testsuite/gfortran.dg/public_private_module_6.f90 @@ -11,4 +11,7 @@ module m integer, save :: aaaa end module m -! { dg-final { scan-assembler-not "aaaa" } } +! The xfail below has appeared with the introduction of submodules. 'aaaa' +! now is TREE_PUBLIC but has DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN set. + +! { dg-final { scan-assembler-not "aaaa" { xfail *-*-* } } } diff --git a/gcc/testsuite/gfortran.dg/submodule_1.f08 b/gcc/testsuite/gfortran.dg/submodule_1.f08 index d117dc6dfd9..578492e54e7 100644 --- a/gcc/testsuite/gfortran.dg/submodule_1.f08 +++ b/gcc/testsuite/gfortran.dg/submodule_1.f08 @@ -170,6 +170,6 @@ message2 = "" end subroutine end program -! { dg-final { cleanup-submodules "foo_interface_son" } } -! { dg-final { cleanup-submodules "foo_interface_grandson" } } -! { dg-final { cleanup-submodules "foo_interface_daughter" } } +! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } } +! { dg-final { cleanup-submodules "foo_interface@foo_interface_grandson" } } +! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } } diff --git a/gcc/testsuite/gfortran.dg/submodule_10.f08 b/gcc/testsuite/gfortran.dg/submodule_10.f08 new file mode 100644 index 00000000000..4671e393ddc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_10.f08 @@ -0,0 +1,170 @@ +! { dg-do compile } +! +! Checks that PRIVATE enities are visible to submodules. +! +! Contributed by Salvatore Filippone +! +module const_mod + integer, parameter :: ndig=8 + integer, parameter :: ipk_ = selected_int_kind(ndig) + integer, parameter :: longndig=12 + integer, parameter :: long_int_k_ = selected_int_kind(longndig) + integer, parameter :: mpik_ = kind(1) + + integer(ipk_), parameter, public :: success_=0 + +end module const_mod + + +module error_mod + use const_mod + + integer(ipk_), parameter, public :: act_ret_=0 + integer(ipk_), parameter, public :: act_print_=1 + integer(ipk_), parameter, public :: act_abort_=2 + + integer(ipk_), parameter, public :: no_err_ = 0 + + public error, errcomm, get_numerr, & + & error_handler, & + & ser_error_handler, par_error_handler + + + interface error_handler + module subroutine ser_error_handler(err_act) + integer(ipk_), intent(inout) :: err_act + end subroutine ser_error_handler + module subroutine par_error_handler(ictxt,err_act) + integer(mpik_), intent(in) :: ictxt + integer(ipk_), intent(in) :: err_act + end subroutine par_error_handler + end interface + + interface error + module subroutine serror() + end subroutine serror + module subroutine perror(ictxt,abrt) + integer(mpik_), intent(in) :: ictxt + logical, intent(in), optional :: abrt + end subroutine perror + end interface + + + interface error_print_stack + module subroutine par_error_print_stack(ictxt) + integer(mpik_), intent(in) :: ictxt + end subroutine par_error_print_stack + module subroutine ser_error_print_stack() + end subroutine ser_error_print_stack + end interface + + interface errcomm + module subroutine errcomm(ictxt, err) + integer(mpik_), intent(in) :: ictxt + integer(ipk_), intent(inout):: err + end subroutine errcomm + end interface errcomm + + + private + + type errstack_node + + integer(ipk_) :: err_code=0 + character(len=20) :: routine='' + integer(ipk_),dimension(5) :: i_err_data=0 + character(len=40) :: a_err_data='' + type(errstack_node), pointer :: next + + end type errstack_node + + + type errstack + type(errstack_node), pointer :: top => null() + integer(ipk_) :: n_elems=0 + end type errstack + + + type(errstack), save :: error_stack + integer(ipk_), save :: error_status = no_err_ + integer(ipk_), save :: verbosity_level = 1 + integer(ipk_), save :: err_action = act_abort_ + integer(ipk_), save :: debug_level = 0, debug_unit, serial_debug_level=0 + +contains +end module error_mod + +submodule (error_mod) error_impl_mod + use const_mod +contains + ! checks whether an error has occurred on one of the processes in the execution pool + subroutine errcomm(ictxt, err) + integer(mpik_), intent(in) :: ictxt + integer(ipk_), intent(inout):: err + + + end subroutine errcomm + + subroutine ser_error_handler(err_act) + implicit none + integer(ipk_), intent(inout) :: err_act + + if (err_act /= act_ret_) & + & call error() + if (err_act == act_abort_) stop + + return + end subroutine ser_error_handler + + subroutine par_error_handler(ictxt,err_act) + implicit none + integer(mpik_), intent(in) :: ictxt + integer(ipk_), intent(in) :: err_act + + if (err_act == act_print_) & + & call error(ictxt, abrt=.false.) + if (err_act == act_abort_) & + & call error(ictxt, abrt=.true.) + + return + + end subroutine par_error_handler + + subroutine par_error_print_stack(ictxt) + integer(mpik_), intent(in) :: ictxt + + call error(ictxt, abrt=.false.) + + end subroutine par_error_print_stack + + subroutine ser_error_print_stack() + + call error() + end subroutine ser_error_print_stack + + subroutine serror() + + implicit none + + end subroutine serror + + subroutine perror(ictxt,abrt) + use const_mod + implicit none + integer(mpik_), intent(in) :: ictxt + logical, intent(in), optional :: abrt + + end subroutine perror + +end submodule error_impl_mod + +program testlk + use error_mod + implicit none + + call error() + + stop +end program testlk +! { dg-final { cleanup-submodules "error_mod@error_impl_mod" } } + diff --git a/gcc/testsuite/gfortran.dg/submodule_5.f08 b/gcc/testsuite/gfortran.dg/submodule_5.f08 index 3141c4c4c99..78f8b9ab512 100644 --- a/gcc/testsuite/gfortran.dg/submodule_5.f08 +++ b/gcc/testsuite/gfortran.dg/submodule_5.f08 @@ -49,3 +49,4 @@ contains end SUBMODULE foo_interface_daughter end +! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } } diff --git a/gcc/testsuite/gfortran.dg/submodule_9.f08 b/gcc/testsuite/gfortran.dg/submodule_9.f08 index 4589ebcd6d2..873979d1feb 100644 --- a/gcc/testsuite/gfortran.dg/submodule_9.f08 +++ b/gcc/testsuite/gfortran.dg/submodule_9.f08 @@ -38,3 +38,4 @@ program a_s implicit none call p() end program +! { dg-final { cleanup-submodules "mod_a@b" } } diff --git a/gcc/testsuite/lib/fortran-modules.exp b/gcc/testsuite/lib/fortran-modules.exp index 0e2f30accc4..f1f04d9d15d 100644 --- a/gcc/testsuite/lib/fortran-modules.exp +++ b/gcc/testsuite/lib/fortran-modules.exp @@ -17,6 +17,7 @@ # helper to deal with fortran modules # Remove files for specified Fortran modules. +# This includes both .mod and .smod files. proc cleanup-modules { modlist } { global clean foreach mod [concat $modlist $clean] { @@ -27,6 +28,7 @@ proc cleanup-modules { modlist } { } remote_file build delete $m } + cleanup-submodules $modlist } # Remove files for specified Fortran submodules.