re PR libfortran/36044 (user-requested backtrace)

2012-12-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36044
	* gfortran.h (gfc_isym_id): Add GFC_ISYM_BACKTRACE.
	* intrinsic.c (add_subroutines): Add "backtrace".
	* intrinsic.texi (BACKTRACE): Document BACKTRACE intrinsic.


2012-12-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36044
	* gfortran.map: Add _gfortran_backtrace.
	* libgfortran.h: Rename 'show_backtrace' and export.
	* runtime/backtrace.c (show_backtrace): Rename to 'backtrace'.
	Don't show message. Close file descriptor. Export.
	* runtime/compile_options.c (backtrace_handler): Renamed
	'show_backtrace'. Move message outside.
	* runtime/error.c (sys_abort): Ditto.

From-SVN: r194648

gcc/fortran/ChangeLog

+2012-12-20  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36044
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_BACKTRACE.
+	* intrinsic.c (add_subroutines): Add "backtrace".
+	* intrinsic.texi (BACKTRACE): Document BACKTRACE intrinsic.
+
 2012-12-20  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/54818

gcc/fortran/gfortran.h

@@ -505,6 +505,7 @@ enum gfc_isym_id
   GFC_ISYM_SHIFTA,
   GFC_ISYM_SHIFTL,
   GFC_ISYM_SHIFTR,
+  GFC_ISYM_BACKTRACE,
   GFC_ISYM_SIGN,
   GFC_ISYM_SIGNAL,
   GFC_ISYM_SI_KIND,

gcc/fortran/intrinsic.c

@@ -2896,6 +2896,8 @@ add_subroutines (void)
 	      "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_IN);
 
+  add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
+
   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
 	      GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
 	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);

gcc/fortran/intrinsic.texi

@@ -63,6 +63,7 @@ Some basic guidelines for editing this document:
 * @code{ATANH}:         ATANH,     Inverse hyperbolic tangent function
 * @code{ATOMIC_DEFINE}: ATOMIC_DEFINE, Setting a variable atomically
 * @code{ATOMIC_REF}:    ATOMIC_REF, Obtaining the value of a variable atomically
+* @code{BACKTRACE}:     BACKTRACE, Show a backtrace
 * @code{BESSEL_J0}:     BESSEL_J0, Bessel function of the first kind of order 0
 * @code{BESSEL_J1}:     BESSEL_J1, Bessel function of the first kind of order 1
 * @code{BESSEL_JN}:     BESSEL_JN, Bessel function of the first kind
@@ -349,6 +350,7 @@ the applicable standard for each intrinsic procedure is noted.
 @item @emph{Description}:
 @code{ABORT} causes immediate termination of the program.  On operating
 systems that support a core dump, @code{ABORT} will produce a core dump.
+It will also print a backtrace, unless @code{-fno-backtrace} is given.
 
 @item @emph{Standard}:
 GNU extension
@@ -371,7 +373,7 @@ end program test_abort
 @end smallexample
 
 @item @emph{See also}:
-@ref{EXIT}, @ref{KILL}
+@ref{EXIT}, @ref{KILL}, @ref{BACKTRACE}
 
 @end table
 
@@ -1644,6 +1646,35 @@ end program atomic
 
 
 
+@node BACKTRACE
+@section @code{BACKTRACE} --- Show a backtrace
+@fnindex BACKTRACE
+@cindex backtrace
+
+@table @asis
+@item @emph{Description}:
+@code{BACKTRACE} shows a backtrace at an arbitrary place in user code. Program
+execution continues normally afterwards. The backtrace information is printed
+to the unit corresponding to @code{ERROR_UNIT} in @code{ISO_FORTRAN_ENV}.
+
+@item @emph{Standard}:
+GNU Extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL BACKTRACE}
+
+@item @emph{Arguments}:
+None
+
+@item @emph{See also}:
+@ref{ABORT}
+@end table
+
+
+
 @node BESSEL_J0
 @section @code{BESSEL_J0} --- Bessel function of the first kind of order 0
 @fnindex BESSEL_J0

libgfortran/ChangeLog

+2012-12-20  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36044
+	* gfortran.map: Add _gfortran_backtrace.
+	* libgfortran.h: Rename 'show_backtrace' and export.
+	* runtime/backtrace.c (show_backtrace): Rename to 'backtrace'.
+	Don't show message. Close file descriptor. Export.
+	* runtime/compile_options.c (backtrace_handler): Renamed
+	'show_backtrace'. Move message outside.
+	* runtime/error.c (sys_abort): Ditto.
+
 2012-12-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	* intrinsics/extends_type_of.c : Return correct results for

libgfortran/gfortran.map

@@ -1192,6 +1192,7 @@ GFORTRAN_1.4 {
 GFORTRAN_1.5 {
   global:
     _gfortran_ftell2;
+    _gfortran_backtrace;
 } GFORTRAN_1.4; 
 
 F2C_1.0 {

libgfortran/libgfortran.h

@@ -667,8 +667,8 @@ internal_proto(find_addr2line);
 
 /* backtrace.c */
 
-extern void show_backtrace (void);
-internal_proto(show_backtrace);
+extern void backtrace (void);
+iexport_proto(backtrace);
 
 /* error.c */
 

libgfortran/runtime/backtrace.c

@@ -190,14 +190,12 @@ trace_function (struct _Unwind_Context *context, void *state_ptr)
 /* Display the backtrace.  */
 
 void
-show_backtrace (void)
+backtrace (void)
 {
   bt_state state;
   state.frame_number = 0;
   state.error = 0;
 
-  estr_write ("\nBacktrace for this error:\n");
-
 #if CAN_PIPE
 
   if (addr2line_path == NULL)
@@ -261,6 +259,7 @@ show_backtrace (void)
     if (state.error)
       goto fallback;
     close (inp[1]);
+    close (f[0]);
     wait (NULL);
     return;
 
@@ -277,3 +276,4 @@ fallback_noerr:
   state.direct_output = 1;
   _Unwind_Backtrace (trace_function, &state);
 }
+iexport(backtrace);

libgfortran/runtime/compile_options.c

@@ -126,7 +126,8 @@ backtrace_handler (int signum)
   fatal_error_in_progress = 1;
 
   show_signal (signum);
-  show_backtrace();
+  estr_write ("\nBacktrace for this error:\n");
+  backtrace ();
 
   /* Now reraise the signal.  We reactivate the signal's
      default handling, which is to terminate the process.

libgfortran/runtime/error.c

@@ -166,7 +166,8 @@ sys_abort (void)
   if (options.backtrace == 1
       || (options.backtrace == -1 && compile_options.backtrace == 1))
     {
-      show_backtrace ();
+      estr_write ("\nProgram aborted. Backtrace:\n");
+      backtrace ();
       signal (SIGABRT, SIG_DFL);
     }