[gcc r13-5967] Fortran: Add !GCC$ attributes NOINLINE,NORETURN,WEAK

[gcc r13-5967] Fortran: Add !GCC$ attributes NOINLINE,NORETURN,WEAK

[Harald Anlauf]

https://gcc.gnu.org/g:086a1df4374962787db37c1f0d1bd9beb828f9e3

commit r13-5967-g086a1df4374962787db37c1f0d1bd9beb828f9e3
Author: Rimvydas Jasinskas <rimvydas.jas@gmail.com>
Date:   Sun Feb 12 06:16:51 2023 +0000

    Fortran: Add !GCC$ attributes NOINLINE,NORETURN,WEAK
    
    gcc/fortran/ChangeLog:
    
            * decl.cc: Add EXT_ATTR_NOINLINE, EXT_ATTR_NORETURN, EXT_ATTR_WEAK.
            * gfortran.h (ext_attr_id_t): Ditto.
            * gfortran.texi (GCC$ ATTRIBUTES): Document them.
            * trans-decl.cc (build_function_decl): Apply them.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/noinline.f90: New test.
            * gfortran.dg/noreturn-1.f90: New test.
            * gfortran.dg/noreturn-2.f90: New test.
            * gfortran.dg/noreturn-3.f90: New test.
            * gfortran.dg/noreturn-4.f90: New test.
            * gfortran.dg/noreturn-5.f90: New test.
            * gfortran.dg/weak-1.f90: New test.
    
    Signed-off-by: Rimvydas Jasinskas <rimvydas.jas@gmail.com>

Diff:
---
 gcc/fortran/decl.cc                      |  3 ++
 gcc/fortran/gfortran.h                   |  3 ++
 gcc/fortran/gfortran.texi                |  7 ++++
 gcc/fortran/trans-decl.cc                | 13 ++++++-
 gcc/testsuite/gfortran.dg/noinline.f90   | 23 ++++++++++++
 gcc/testsuite/gfortran.dg/noreturn-1.f90 | 62 ++++++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/noreturn-2.f90 | 53 +++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/noreturn-3.f90 | 14 ++++++++
 gcc/testsuite/gfortran.dg/noreturn-4.f90 | 11 ++++++
 gcc/testsuite/gfortran.dg/noreturn-5.f90 |  9 +++++
 gcc/testsuite/gfortran.dg/weak-1.f90     |  6 ++++
 11 files changed, 203 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 27b728ff551..eec0314cf4c 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -11732,6 +11732,9 @@ const ext_attr_t ext_attr_list[] = {
   { "fastcall",     EXT_ATTR_FASTCALL,     "fastcall"  },
   { "no_arg_check", EXT_ATTR_NO_ARG_CHECK, NULL        },
   { "deprecated",   EXT_ATTR_DEPRECATED,   NULL	       },
+  { "noinline",     EXT_ATTR_NOINLINE,     NULL	       },
+  { "noreturn",     EXT_ATTR_NORETURN,     NULL	       },
+  { "weak",	    EXT_ATTR_WEAK,	   NULL	       },
   { NULL,           EXT_ATTR_LAST,         NULL        }
 };
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9884a55882b..a893ee06f3d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -838,6 +838,9 @@ typedef enum
   EXT_ATTR_FASTCALL,
   EXT_ATTR_NO_ARG_CHECK,
   EXT_ATTR_DEPRECATED,
+  EXT_ATTR_NOINLINE,
+  EXT_ATTR_NORETURN,
+  EXT_ATTR_WEAK,
   EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
 }
 ext_attr_id_t;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index c3813d06c20..c483e13686d 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3246,6 +3246,13 @@ requires an explicit interface.
 @item @code{DEPRECATED} -- print a warning when using a such-tagged
 deprecated procedure, variable or parameter; the warning can be suppressed
 with @option{-Wno-deprecated-declarations}.
+@item @code{NOINLINE} -- prevent inlining given function.
+@item @code{NORETURN} -- add a hint that a given function cannot return.
+@item @code{WEAK} -- emit the declaration of an external symbol as a weak
+symbol rather than a global.  This is primarily useful in defining library
+functions that can be overridden in user code, though it can also be used with
+non-function declarations.  The overriding symbol must have the same type as
+the weak symbol.
 @end itemize
 
 
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index f7a7ff607cd..ff64588b9a8 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2338,7 +2338,7 @@ module_sym:
     }
 
   /* Mark non-returning functions.  */
-  if (sym->attr.noreturn)
+  if (sym->attr.noreturn || sym->attr.ext_attr & (1 << EXT_ATTR_NORETURN))
       TREE_THIS_VOLATILE(fndecl) = 1;
 
   sym->backend_decl = fndecl;
@@ -2482,6 +2482,17 @@ build_function_decl (gfc_symbol * sym, bool global)
       TREE_SIDE_EFFECTS (fndecl) = 0;
     }
 
+  /* Mark noinline functions.  */
+  if (attr.ext_attr & (1 << EXT_ATTR_NOINLINE))
+    DECL_UNINLINABLE (fndecl) = 1;
+
+  /* Mark noreturn functions.  */
+  if (attr.ext_attr & (1 << EXT_ATTR_NORETURN))
+    TREE_THIS_VOLATILE (fndecl) = 1;
+
+  /* Mark weak functions.  */
+  if (attr.ext_attr & (1 << EXT_ATTR_WEAK))
+    declare_weak (fndecl);
 
   /* Layout the function declaration and put it in the binding level
      of the current function.  */
diff --git a/gcc/testsuite/gfortran.dg/noinline.f90 b/gcc/testsuite/gfortran.dg/noinline.f90
new file mode 100644
index 00000000000..edae72ea5eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noinline.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-dom2" }
+
+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(*)
+!GCC$ ATTRIBUTES noinline :: foo
+do j=1,n
+  b(m+j-1)=p(j)
+enddo
+m=m+n
+end subroutine foo
+
+! { dg-final { scan-tree-dump-times "foo \\(" 4 "dom2"} }
diff --git a/gcc/testsuite/gfortran.dg/noreturn-1.f90 b/gcc/testsuite/gfortran.dg/noreturn-1.f90
new file mode 100644
index 00000000000..3155cdf22aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noreturn-1.f90
@@ -0,0 +1,62 @@
+! Check for various valid and erroneous "noreturn" cases.
+! { dg-do compile }
+! { dg-options "-O2" }
+
+module barbar
+!GCC$ ATTRIBUTES noreturn :: bar1
+contains
+subroutine bar1
+end subroutine bar1 ! { dg-warning "'noreturn' function does return" "detect falling off end of noreturn" }
+end module
+
+subroutine foo1
+!GCC$ ATTRIBUTES noreturn :: foo1
+end subroutine foo1 ! { dg-warning "'noreturn' function does return" "detect falling off end of noreturn" }
+
+subroutine foo2
+!GCC$ ATTRIBUTES noreturn :: foo2
+call exit(0)
+end subroutine foo2 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+subroutine foo3
+end subroutine foo3 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+subroutine foo4
+!GCC$ ATTRIBUTES noreturn :: foo4
+call foo2()
+end subroutine foo4 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+subroutine foo5
+!GCC$ ATTRIBUTES noreturn :: foo5
+return              ! { dg-warning "'noreturn' function does return" "detect invalid return" }
+end subroutine foo5
+
+subroutine foo6
+return
+end subroutine foo6 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+subroutine foo7
+call foo6()
+end subroutine foo7 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+subroutine foo8
+!GCC$ ATTRIBUTES noreturn :: foo8
+call foo7()
+end subroutine foo8 ! { dg-warning "'noreturn' function does return" "detect return from tail call" }
+
+subroutine foo9
+!GCC$ ATTRIBUTES noreturn :: foo9
+interface
+subroutine bar
+!GCC$ ATTRIBUTES noreturn :: bar
+end subroutine bar
+end interface
+call bar()
+end subroutine foo9 ! { dg-bogus "warning:" "this function should not get any warnings" }
+
+function ffo1()
+implicit none
+!GCC$ ATTRIBUTES noreturn :: ffo1
+integer :: ffo1
+ffo1 = 0
+end function ffo1   ! { dg-warning "'noreturn' function does return" "detect falling off end of noreturn" }
diff --git a/gcc/testsuite/gfortran.dg/noreturn-2.f90 b/gcc/testsuite/gfortran.dg/noreturn-2.f90
new file mode 100644
index 00000000000..1bb4793234f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noreturn-2.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-O2 -Wuninitialized" }
+
+subroutine foo1
+implicit none
+interface
+subroutine bar1
+!GCC$ ATTRIBUTES noreturn :: bar1
+end subroutine
+end interface
+real,allocatable :: d(:) ! { dg-note "declared here" "note" }
+d = 0. ! { dg-warning "used uninitialized" "uninitialized descriptor" }
+call bar1()
+d = 0. ! { dg-bogus "warning:" "not optimized out" }
+end subroutine foo1
+
+function foo2()
+integer :: foo2
+interface
+subroutine bar2
+!GCC$ ATTRIBUTES noreturn :: bar2
+end subroutine
+end interface
+call bar2
+return ! { dg-bogus "__result_foo2' is used uninitialized" "return" }
+foo2 = 0
+end function foo2
+
+subroutine foo3
+implicit none
+integer :: i,j
+interface
+subroutine abort2
+!GCC$ ATTRIBUTES noreturn :: abort2
+end subroutine
+end interface
+call abort2()
+do i=1,j-1 ; end do ! { dg-bogus "is used uninitialized" "uninitialized" }
+end subroutine foo3
+
+function foo4()
+integer :: foo4
+!$GCC$ ATTRIBUTES noreturn :: foo4
+foo4 = 1
+end function
+
+subroutine foo5(k)
+implicit none
+integer :: i, k
+!GCC$ ATTRIBUTES noreturn :: mpi_abort
+call mpi_abort()
+k = i
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/noreturn-3.f90 b/gcc/testsuite/gfortran.dg/noreturn-3.f90
new file mode 100644
index 00000000000..fefa092aef0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noreturn-3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-additional-options "-Wuninitialized -Wmaybe-uninitialized" }
+
+subroutine foo
+implicit none
+integer :: i
+!GCC$ ATTRIBUTES noreturn :: mpi_abort
+if (getpid() == 1) then
+  call mpi_abort()
+else
+  i = 8
+endif
+if (i > 0) print *, i
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/noreturn-4.f90 b/gcc/testsuite/gfortran.dg/noreturn-4.f90
new file mode 100644
index 00000000000..e4024e27ccc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noreturn-4.f90
@@ -0,0 +1,11 @@
+! { dg-do run { target { nonpic || pie_enabled } } }
+! { dg-options "-O2" }
+
+program bar
+call foo1()
+call noreturn_autodetection_failed() ! check if optimized out 
+end program
+
+subroutine foo1
+stop 0
+end subroutine foo1
diff --git a/gcc/testsuite/gfortran.dg/noreturn-5.f90 b/gcc/testsuite/gfortran.dg/noreturn-5.f90
new file mode 100644
index 00000000000..d07b0502f08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noreturn-5.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-O2" }
+
+subroutine bar
+!GCC$ ATTRIBUTES noreturn :: foo1
+call foo1()
+call noreturn_autodetection_failed()
+end subroutine
+! /* { dg-final { scan-assembler-not "noreturn_autodetection_failed" } } */
diff --git a/gcc/testsuite/gfortran.dg/weak-1.f90 b/gcc/testsuite/gfortran.dg/weak-1.f90
new file mode 100644
index 00000000000..d9aca686775
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/weak-1.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-require-weak "" }
+! { dg-final { scan-assembler "weak\[^ \t\]*\[ \t\]_?impl" } }
+subroutine impl
+!GCC$ ATTRIBUTES weak :: impl
+end subroutine