From e5319c1733bca56be710c8cbce763fe459dfae73 Mon Sep 17 00:00:00 2001 From: Rimvydas Jasinskas Date: Thu, 23 Feb 2023 12:59:57 +0000 Subject: Fortran: Add support for module-wide attributes The WEAK attribute handling needs to be delayed after sym->attr.access is set. gcc/fortran/ChangeLog: * decl.cc (gfc_match_gcc_attributes): Add diagnostic for NO_ARG_CHECK. * gfortran.h (gfc_apply_mod_ext_attr): New prototype. (gfc_namespace): Add mod_ext_attr bitfield. * resolve.cc (resolve_types): Use gfc_apply_mod_ext_attr(). * symbol.cc (apply_mod_ext_attr): New procedure. (gfc_apply_mod_ext_attr): New procedure. * trans-decl.cc (build_function_decl): Handle module-wide WEAK attribute for public procedures. Move local 'attr' copy down. (gfc_create_module_variable): Handle module-wide WEAK attribute for non-private variables. gcc/testsuite/ChangeLog: * gfortran.dg/attr_deprecated-3.f90: New test. * gfortran.dg/attr_deprecated-4.f90: New test. * gfortran.dg/no_arg_check_4.f90: New test. * gfortran.dg/noinline-2.f90: New test. * gfortran.dg/noreturn-6.f90: New test. * gfortran.dg/weak-10.f90: New test. * gfortran.dg/weak-11.f90: New test. * gfortran.dg/weak-12.f90: New test. * gfortran.dg/weak-9.f90: New test. Signed-off-by: Rimvydas Jasinskas --- gcc/fortran/decl.cc | 11 ++++++ gcc/fortran/gfortran.h | 3 ++ gcc/fortran/resolve.cc | 3 ++ gcc/fortran/symbol.cc | 38 +++++++++++++++++++ gcc/fortran/trans-decl.cc | 16 +++++++- .../gfortran.dg/attr_deprecated-3.f90 | 30 +++++++++++++++ .../gfortran.dg/attr_deprecated-4.f90 | 24 ++++++++++++ gcc/testsuite/gfortran.dg/no_arg_check_4.f90 | 14 +++++++ gcc/testsuite/gfortran.dg/noinline-2.f90 | 29 ++++++++++++++ gcc/testsuite/gfortran.dg/noreturn-6.f90 | 10 +++++ gcc/testsuite/gfortran.dg/weak-10.f90 | 17 +++++++++ gcc/testsuite/gfortran.dg/weak-11.f90 | 17 +++++++++ gcc/testsuite/gfortran.dg/weak-12.f90 | 18 +++++++++ gcc/testsuite/gfortran.dg/weak-9.f90 | 17 +++++++++ 14 files changed, 245 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/attr_deprecated-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/attr_deprecated-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/no_arg_check_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/noinline-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/noreturn-6.f90 create mode 100644 gcc/testsuite/gfortran.dg/weak-10.f90 create mode 100644 gcc/testsuite/gfortran.dg/weak-11.f90 create mode 100644 gcc/testsuite/gfortran.dg/weak-12.f90 create mode 100644 gcc/testsuite/gfortran.dg/weak-9.f90 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index eec0314cf4c..9bc05f5acd8 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -11811,6 +11811,17 @@ gfc_match_gcc_attributes (void) sym->attr.ext_attr |= attr.ext_attr; + if (sym->attr.flavor == FL_MODULE) + { + if (attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) + { + gfc_error ("The % attribute cannot be applied" + " module-wide at %C"); + return MATCH_NO; + } + gfc_current_ns->mod_ext_attr |= attr.ext_attr; + } + if (gfc_match_eos () == MATCH_YES) break; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fea25312cf4..5e06429424b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2160,6 +2160,8 @@ typedef struct gfc_namespace int save_all, seen_save, seen_implicit_none; + unsigned mod_ext_attr; + /* Normally we don't need to refcount namespaces. However when we read a module containing a function with multiple entry points, this will appear as several functions with the same formal namespace. */ @@ -3513,6 +3515,7 @@ void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *)); void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *)); void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *)); void gfc_save_all (gfc_namespace *); +void gfc_apply_mod_ext_attr (gfc_namespace *); void gfc_enforce_clean_symbol_state (void); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 2780c82c798..839b63d1715 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -17600,6 +17600,9 @@ resolve_types (gfc_namespace *ns) if (ns->save_all || (!flag_automatic && !recursive)) gfc_save_all (ns); + if (ns->mod_ext_attr) + gfc_apply_mod_ext_attr (ns); + iter_stack = NULL; for (d = ns->data; d; d = d->next) resolve_data (d); diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 2ce0f3e4df7..2e202443b82 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -4284,6 +4284,44 @@ gfc_save_all (gfc_namespace *ns) gfc_traverse_ns (ns, save_symbol); } +/* Given a symbol, apply module-wide attributes if it is allowed. */ + +static void +apply_mod_ext_attr (gfc_symbol *sym) +{ + unsigned ext_mask = (1 << EXT_ATTR_LAST) - 1; + + if (sym->attr.use_assoc) + return; + + /* Exclude NO_ARG_CHECK attribute by default, handled in decl.cc. */ + ext_mask -= (1 << EXT_ATTR_NO_ARG_CHECK); + + /* Exclude WEAK attribute here, handled once attr.access is fully set. */ + ext_mask -= (1 << EXT_ATTR_WEAK); + + /* Ignore all procedure-only module-wide attributes for variables. */ + if (sym->attr.flavor != FL_PROCEDURE) + { + ext_mask -= 1 << EXT_ATTR_STDCALL; + ext_mask -= 1 << EXT_ATTR_CDECL; + ext_mask -= 1 << EXT_ATTR_FASTCALL; + ext_mask -= 1 << EXT_ATTR_NOINLINE; + ext_mask -= 1 << EXT_ATTR_NORETURN; + } + + sym->attr.ext_attr |= sym->ns->mod_ext_attr & ext_mask; +} + + +/* Apply module-wide attributes to symbols where possible. */ + +void +gfc_apply_mod_ext_attr (gfc_namespace *ns) +{ + gfc_traverse_ns (ns, apply_mod_ext_attr); +} + /* Make sure that no changes to symbols are pending. */ diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 24a85cf6043..5f3a75a1524 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2399,8 +2399,6 @@ build_function_decl (gfc_symbol * sym, bool global) fndecl = build_decl (input_location, FUNCTION_DECL, gfc_sym_identifier (sym), type); - attr = sym->attr; - /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes; TREE_PUBLIC specifies whether a function is globally addressable (i.e. the opposite of declaring a function as static in C). */ @@ -2421,6 +2419,13 @@ build_function_decl (gfc_symbol * sym, bool global) if (sym->attr.referenced || sym->attr.entry_master) TREE_USED (fndecl) = 1; + /* Add module-wide WEAK attribute after attr.access is set. */ + if (sym->module && sym->attr.access != ACCESS_PRIVATE + && sym->ns->mod_ext_attr & (1 << EXT_ATTR_WEAK)) + sym->attr.ext_attr |= (1 << EXT_ATTR_WEAK); + + attr = sym->attr; + attributes = add_attributes_to_decl (attr, NULL_TREE); decl_attributes (&fndecl, attributes, 0); @@ -5273,6 +5278,13 @@ gfc_create_module_variable (gfc_symbol * sym) "Unused PRIVATE module variable %qs declared at %L", sym->name, &sym->declared_at); + /* Add module-wide WEAK attribute after attr.access is set. Allow only + explicit weak declaration for private variables for now, mainly to avoid + unintended complications with hidden/weak symbols. */ + if (sym->module && sym->attr.access != ACCESS_PRIVATE + && sym->ns->mod_ext_attr & (1 << EXT_ATTR_WEAK)) + sym->attr.ext_attr |= (1 << EXT_ATTR_WEAK); + /* We always want module variables to be created. */ sym->attr.referenced = 1; /* Create the decl. */ diff --git a/gcc/testsuite/gfortran.dg/attr_deprecated-3.f90 b/gcc/testsuite/gfortran.dg/attr_deprecated-3.f90 new file mode 100644 index 00000000000..39bd6c388bd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/attr_deprecated-3.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } + +module m + implicit none + integer :: A + integer, parameter :: PARM = 5 ! { dg-warning "Using parameter 'parm' declared at .1. is deprecated" "TODO" { xfail *-*-* } } +!GCC$ ATTRIBUTES DEPRECATED :: m +contains +subroutine foo +end +integer function func() + func = 42 +end +subroutine bar + integer :: i + call foo ! { dg-warning "Using subroutine 'foo' at .1. is deprecated" } + print *, A ! { dg-warning "Using variable 'a' at .1. is deprecated" } + i = func() ! { dg-warning "Using function 'func' at .1. is deprecated" } + print *, PARM +end + +end module m + +use m ! { dg-warning "Using parameter 'parm' declared at .1. is deprecated" } + integer :: i + call foo ! { dg-warning "Using subroutine 'foo' at .1. is deprecated" } + print *, A ! { dg-warning "Using variable 'a' at .1. is deprecated" } + i = func() ! { dg-warning "Using function 'func' at .1. is deprecated" } + print *, PARM +end diff --git a/gcc/testsuite/gfortran.dg/attr_deprecated-4.f90 b/gcc/testsuite/gfortran.dg/attr_deprecated-4.f90 new file mode 100644 index 00000000000..22237b91c06 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/attr_deprecated-4.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } + +module m + implicit none +!GCC$ ATTRIBUTES DEPRECATED :: m + interface dar + procedure :: foo + subroutine bar(p) + implicit none + real :: p + end subroutine + end interface +contains +subroutine foo(n) + implicit none + integer :: n +end subroutine +end module m + +use m + call foo(1) ! { dg-warning "Using subroutine 'foo' at .1. is deprecated" } + call dar(1) ! { dg-warning "Using subroutine 'foo' at .1. is deprecated" } + call dar(1.) ! { dg-warning "Using subroutine 'bar' at .1. is deprecated" } +end diff --git a/gcc/testsuite/gfortran.dg/no_arg_check_4.f90 b/gcc/testsuite/gfortran.dg/no_arg_check_4.f90 new file mode 100644 index 00000000000..097184331e1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/no_arg_check_4.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! +module mpi_interface + implicit none +!GCC$ attributes NO_ARG_CHECK :: mpi_interface +! { dg-error "The 'NO_ARG_CHECK' attribute cannot be applied module-wide" "reject" {target *-*-*} .-1 } + integer :: i +contains + subroutine foo(n,p) + implicit none + integer :: n + real :: p + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/noinline-2.f90 b/gcc/testsuite/gfortran.dg/noinline-2.f90 new file mode 100644 index 00000000000..96010fa7cf5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/noinline-2.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-O2 -fdump-tree-dom2" } + +module m +!GCC$ ATTRIBUTES noinline :: m +integer :: abc(7) +contains + +subroutine bar(n,m,p,s) +implicit none +integer :: n,m +real,intent(inout) :: p(n),s(*) +call foo(n,m,p,s) +call foo(n,m,p,s) +end subroutine bar + +subroutine foo(n,m,p,b) +implicit none +integer :: n,m,j +real,intent(inout) :: p(n),b(*) +do j=1,n + b(m+j-1)=p(j) +enddo +m=m+n +end subroutine foo + +end module + +! { dg-final { scan-tree-dump-times "foo \\(" 4 "dom2"} } diff --git a/gcc/testsuite/gfortran.dg/noreturn-6.f90 b/gcc/testsuite/gfortran.dg/noreturn-6.f90 new file mode 100644 index 00000000000..4e1de384cfe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/noreturn-6.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! { dg-options "-Wall -Wextra" } + +module m +!GCC$ ATTRIBUTES noreturn :: m +integer :: ijk +contains +subroutine foo +end subroutine foo ! { dg-warning "'noreturn' function does return" "" } +end module diff --git a/gcc/testsuite/gfortran.dg/weak-10.f90 b/gcc/testsuite/gfortran.dg/weak-10.f90 new file mode 100644 index 00000000000..c382c455d08 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/weak-10.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-require-weak "" } +! { dg-options "-Wall -Wextra" } +module foo +implicit none +!GCC$ ATTRIBUTES weak :: foo +integer :: ijk +private :: ijk,bar +!GCC$ ATTRIBUTES weak :: bar +contains +subroutine bar ! { dg-error "weak declaration of 'bar' must be public" "" } +ijk = 1 +end subroutine +subroutine dar +call bar +end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/weak-11.f90 b/gcc/testsuite/gfortran.dg/weak-11.f90 new file mode 100644 index 00000000000..e49f13101a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/weak-11.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-require-weak "" } +! { dg-skip-if "" { x86_64-*-mingw* } } +! { dg-skip-if "" { nvptx-*-* } } +! { dg-final { scan-assembler "weak\[^ \t\]*\[ \t\]_?__foo_MOD_abc" } } +! { dg-final { scan-assembler "weak\[^ \t\]*\[ \t\]_?__foo_MOD_bar" } } +! { dg-final { scan-assembler "weak\[^ \t\]*\[ \t\]_?__foo_MOD_dar" } } +module foo +implicit none +!GCC$ ATTRIBUTES weak :: foo +real :: abc(7) +contains + subroutine bar + end subroutine + integer function dar() + end function +end module diff --git a/gcc/testsuite/gfortran.dg/weak-12.f90 b/gcc/testsuite/gfortran.dg/weak-12.f90 new file mode 100644 index 00000000000..39deb1eafbe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/weak-12.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-require-weak "" } +! { dg-skip-if "" { x86_64-*-mingw* } } +! { dg-skip-if "" { nvptx-*-* } } +! { dg-final { scan-assembler-not "weak\[^ \t\]*\[ \t\]_?__foo_MOD_abc" } } +! { dg-final { scan-assembler-not "weak\[^ \t\]*\[ \t\]_?__foo_MOD_bar" } } +! { dg-final { scan-assembler-not "weak\[^ \t\]*\[ \t\]_?__foo_MOD_dar" } } +module foo +implicit none +private +!GCC$ ATTRIBUTES weak :: foo +real :: abc(7) +contains + subroutine bar + end subroutine + integer function dar() + end function +end module diff --git a/gcc/testsuite/gfortran.dg/weak-9.f90 b/gcc/testsuite/gfortran.dg/weak-9.f90 new file mode 100644 index 00000000000..b5e92fc09de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/weak-9.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-require-weak "" } +! { dg-options "-Wall -Wextra" } +module foo +implicit none +!GCC$ ATTRIBUTES weak :: foo +integer :: ijk +private +public :: dar +contains +subroutine bar +ijk = 1 +end subroutine +subroutine dar +call bar +end subroutine +end module -- 2.39.2