gfortran.h (gfc_option_t): Add flag_backtrace field.

* gfortran.h (gfc_option_t): Add flag_backtrace field.
	* lang.opt: Add -fbacktrace option.
	* invoke.texi: Document the new option.
	* trans-decl.c (gfc_build_builtin_function_decls): Add new
	option to the call to set_std.
	* options.c (gfc_init_options, gfc_handle_option): Handle the
	new option.

	* runtime/backtrace.c: New file.
	* runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE
	environment variable.
	* runtime/compile_options.c (set_std): Add new argument.
	* runtime/main.c (store_exe_path, full_exe_path): New functions.
	* runtime/error.c (sys_exit): Add call to show_backtrace.
	* libgfortran.h (options_t): New backtrace field.
	(store_exe_path, full_exe_path, show_backtrace): New prototypes.
	* configure.ac: Add checks for execinfo.h, execvp, pipe, dup2,
	close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols
	and getppid.
	* Makefile.am: Add runtime/backtrace.c.
	* fmain.c (main): Add call to store_exe_path.
	* Makefile.in: Renegerate.
	* config.h.in: Renegerate.
	* configure: Regenerate.

From-SVN: r122954
This commit is contained in:
Francois-Xavier Coudert 2007-03-15 13:39:47 +01:00 committed by François-Xavier Coudert
parent 419452fe7e
commit 868d75dbdc
19 changed files with 707 additions and 16 deletions

View file

@ -1,3 +1,13 @@
2007-03-15 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.h (gfc_option_t): Add flag_backtrace field.
* lang.opt: Add -fbacktrace option.
* invoke.texi: Document the new option.
* trans-decl.c (gfc_build_builtin_function_decls): Add new
option to the call to set_std.
* options.c (gfc_init_options, gfc_handle_option): Handle the
new option.
2007-03-15 Tobias Burnus <burnus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>

View file

@ -1659,6 +1659,7 @@ typedef struct
int flag_f2c;
int flag_automatic;
int flag_backslash;
int flag_backtrace;
int flag_allow_leading_underscore;
int flag_dump_core;
int flag_external_blas;

View file

@ -134,8 +134,8 @@ and Warnings}.
@item Debugging Options
@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
@gccoptlist{-fdump-parse-tree -ffpe-trap=@var{list}
-fdump-core}
@gccoptlist{-fdump-parse-tree -ffpe-trap=@var{list} @gol
-fdump-core -fbacktrace}
@item Directory Options
@xref{Directory Options,,Options for Directory Search}.
@ -562,6 +562,15 @@ zero), @samp{overflow} (overflow in a floating point operation),
@samp{precision} (loss of precision during operation) and @samp{denormal}
(operation produced a denormal value).
@cindex -fbacktrace option
@cindex options, -fbacktrace
@item -fbacktrace
@cindex backtrace
@cindex trace
Specify that, when a runtime error is encountered, the Fortran runtime
library should output a backtrace of the error. This option
only has influence for compilation of the Fortran main program.
@cindex -fdump-core option
@cindex options, -fdump-core
@item -fdump-core

View file

@ -93,6 +93,10 @@ fbackslash
Fortran
Specify that backslash in string introduces an escape character
fbacktrace
Fortran
Produce a backtrace when a runtime error is encountered
fblas-matmul-limit=
Fortran RejectNegative Joined UInteger
-fblas-matmul-limit=<n> Size of the smallest matrix for which matmul will use BLAS

View file

@ -94,6 +94,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.flag_preprocessed = 0;
gfc_option.flag_automatic = 1;
gfc_option.flag_backslash = 1;
gfc_option.flag_backtrace = 0;
gfc_option.flag_allow_leading_underscore = 0;
gfc_option.flag_dump_core = 0;
gfc_option.flag_external_blas = 0;
@ -474,6 +475,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.flag_backslash = value;
break;
case OPT_fbacktrace:
gfc_option.flag_backtrace = value;
break;
case OPT_fdump_core:
gfc_option.flag_dump_core = value;
break;

View file

@ -2378,7 +2378,8 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_set_std =
gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
void_type_node,
4,
5,
gfc_int4_type_node,
gfc_int4_type_node,
gfc_int4_type_node,
gfc_int4_type_node,
@ -3144,7 +3145,9 @@ gfc_generate_function_code (gfc_namespace * ns)
build_int_cst (gfc_int4_type_node,
pedantic),
build_int_cst (gfc_int4_type_node,
gfc_option.flag_dump_core));
gfc_option.flag_dump_core),
build_int_cst (gfc_int4_type_node,
gfc_option.flag_backtrace));
gfc_add_expr_to_block (&body, tmp);
}

View file

@ -1,3 +1,22 @@
2007-03-15 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* runtime/backtrace.c: New file.
* runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE
environment variable.
* runtime/compile_options.c (set_std): Add new argument.
* runtime/main.c (store_exe_path, full_exe_path): New functions.
* runtime/error.c (sys_exit): Add call to show_backtrace.
* libgfortran.h (options_t): New backtrace field.
(store_exe_path, full_exe_path, show_backtrace): New prototypes.
* configure.ac: Add checks for execinfo.h, execvp, pipe, dup2,
close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols
and getppid.
* Makefile.am: Add runtime/backtrace.c.
* fmain.c (main): Add call to store_exe_path.
* Makefile.in: Renegerate.
* config.h.in: Renegerate.
* configure: Regenerate.
2007-03-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/31051

View file

@ -97,6 +97,7 @@ runtime/in_pack_generic.c \
runtime/in_unpack_generic.c
gfor_src= \
runtime/backtrace.c \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \

View file

@ -71,8 +71,8 @@ myexeclibLTLIBRARIES_INSTALL = $(INSTALL)
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
libgfortran_la_LIBADD =
am__objects_1 = compile_options.lo environ.lo error.lo fpu.lo main.lo \
memory.lo pause.lo stop.lo string.lo select.lo
am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \
fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo
am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
@ -476,6 +476,7 @@ runtime/in_pack_generic.c \
runtime/in_unpack_generic.c
gfor_src = \
runtime/backtrace.c \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \
@ -1141,6 +1142,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@
@ -1942,6 +1944,13 @@ f2c_specifics.lo: intrinsics/f2c_specifics.F90
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
backtrace.lo: runtime/backtrace.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT backtrace.lo -MD -MP -MF "$(DEPDIR)/backtrace.Tpo" -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/backtrace.Tpo" "$(DEPDIR)/backtrace.Plo"; else rm -f "$(DEPDIR)/backtrace.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/backtrace.c' object='backtrace.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c
compile_options.lo: runtime/compile_options.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF "$(DEPDIR)/compile_options.Tpo" -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/compile_options.Tpo" "$(DEPDIR)/compile_options.Plo"; else rm -f "$(DEPDIR)/compile_options.Tpo"; exit 1; fi

View file

@ -81,6 +81,12 @@
/* Define to 1 if the target supports __attribute__((visibility(...))). */
#undef HAVE_ATTRIBUTE_VISIBILITY
/* Define to 1 if you have the `backtrace' function. */
#undef HAVE_BACKTRACE
/* Define to 1 if you have the `backtrace_symbols' function. */
#undef HAVE_BACKTRACE_SYMBOLS
/* Define if fpclassify is broken. */
#undef HAVE_BROKEN_FPCLASSIFY
@ -171,6 +177,9 @@
/* libm includes clogl */
#undef HAVE_CLOGL
/* Define to 1 if you have the `close' function. */
#undef HAVE_CLOSE
/* complex.h exists */
#undef HAVE_COMPLEX_H
@ -261,6 +270,9 @@
/* Define to 1 if you have the `ctime' function. */
#undef HAVE_CTIME
/* Define to 1 if you have the `dup2' function. */
#undef HAVE_DUP2
/* libm includes erf */
#undef HAVE_ERF
@ -279,9 +291,15 @@
/* libm includes erfl */
#undef HAVE_ERFL
/* Define to 1 if you have the <execinfo.h> header file. */
#undef HAVE_EXECINFO_H
/* Define to 1 if you have the `execl' function. */
#undef HAVE_EXECL
/* Define to 1 if you have the `execvp' function. */
#undef HAVE_EXECVP
/* libm includes exp */
#undef HAVE_EXP
@ -300,6 +318,9 @@
/* libm includes fabsl */
#undef HAVE_FABSL
/* Define to 1 if you have the `fdopen' function. */
#undef HAVE_FDOPEN
/* libm includes feenableexcept */
#undef HAVE_FEENABLEEXCEPT
@ -372,15 +393,15 @@
/* libc includes getpid */
#undef HAVE_GETPID
/* libc includes getppid */
#undef HAVE_GETPPID
/* Define to 1 if you have the `getrlimit' function. */
#undef HAVE_GETRLIMIT
/* Define to 1 if you have the `getrusage' function. */
#undef HAVE_GETRUSAGE
/* Define to 1 if you have the `gettimeofday' function. */
#undef HAVE_GETTIMEOFDAY
/* libc includes getuid */
#undef HAVE_GETUID
@ -486,6 +507,9 @@
/* Define to 1 if you have the `perror' function. */
#undef HAVE_PERROR
/* Define to 1 if you have the `pipe' function. */
#undef HAVE_PIPE
/* libm includes pow */
#undef HAVE_POW
@ -567,6 +591,9 @@
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define to 1 if you have the `strcasestr' function. */
#undef HAVE_STRCASESTR
/* Define to 1 if you have the `strerror' function. */
#undef HAVE_STRERROR

197
libgfortran/configure vendored
View file

@ -6575,7 +6575,8 @@ done
for ac_header in fenv.h fptrap.h float.h
for ac_header in fenv.h fptrap.h float.h execinfo.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if eval "test \"\${$as_ac_Header+set}\" = set"; then
@ -10398,7 +10399,122 @@ done
for ac_func in wait setmode getrlimit gettimeofday
for ac_func in wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test x$gcc_no_link = xyes; then
{ { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
{ (exit 1); exit 1; }; }
fi
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define $ac_func innocuous_$ac_func
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef $ac_func
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
char (*f) () = $ac_func;
#endif
#ifdef __cplusplus
}
#endif
int
main ()
{
return f != $ac_func;
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_var=no"
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
if test `eval echo '${'$as_ac_var'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
done
# Check for glibc backtrace functions
for ac_func in backtrace backtrace_symbols
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
@ -10727,6 +10843,83 @@ _ACEOF
fi
echo "$as_me:$LINENO: checking for getppid in -lc" >&5
echo $ECHO_N "checking for getppid in -lc... $ECHO_C" >&6
if test "${ac_cv_lib_c_getppid+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lc $LIBS"
if test x$gcc_no_link = xyes; then
{ { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
{ (exit 1); exit 1; }; }
fi
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char getppid ();
int
main ()
{
getppid ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
ac_cv_lib_c_getppid=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_lib_c_getppid=no
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
echo "$as_me:$LINENO: result: $ac_cv_lib_c_getppid" >&5
echo "${ECHO_T}$ac_cv_lib_c_getppid" >&6
if test $ac_cv_lib_c_getppid = yes; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_GETPPID 1
_ACEOF
fi
echo "$as_me:$LINENO: checking for getuid in -lc" >&5
echo $ECHO_N "checking for getuid in -lc... $ECHO_C" >&6
if test "${ac_cv_lib_c_getuid+set}" = set; then

View file

@ -164,7 +164,7 @@ AC_HEADER_TIME
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h)
AC_CHECK_HEADERS(fenv.h fptrap.h float.h)
AC_CHECK_HEADERS(fenv.h fptrap.h float.h execinfo.h)
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
GCC_HEADER_STDINT(gstdint.h)
@ -176,7 +176,10 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
AC_CHECK_FUNCS(wait setmode getrlimit gettimeofday)
AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
# Check for glibc backtrace functions
AC_CHECK_FUNCS(backtrace backtrace_symbols)
# Check for types
AC_CHECK_TYPES([intptr_t])
@ -184,6 +187,7 @@ AC_CHECK_TYPES([intptr_t])
# Check libc for getgid, getpid, getuid
AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
AC_CHECK_LIB([c],[getpid],[AC_DEFINE([HAVE_GETPID],[1],[libc includes getpid])])
AC_CHECK_LIB([c],[getppid],[AC_DEFINE([HAVE_GETPPID],[1],[libc includes getppid])])
AC_CHECK_LIB([c],[getuid],[AC_DEFINE([HAVE_GETUID],[1],[libc includes getuid])])
# Check for C99 (and other IEEE) math functions

View file

@ -10,9 +10,13 @@ void MAIN__ (void);
int
main (int argc, char *argv[])
{
/* Store the path of the executable file. */
store_exe_path (argv[0]);
/* Set up the runtime environment. */
set_args (argc, argv);
/* Call the Fortran main program. Internally this is a function
called MAIN__ */
MAIN__ ();

View file

@ -361,7 +361,7 @@ typedef struct
int fpu_round, fpu_precision, fpe;
int sighup, sigint;
int dump_core;
int dump_core, backtrace;
}
options_t;
@ -378,6 +378,7 @@ typedef struct
int pedantic;
int convert;
int dump_core;
int backtrace;
size_t record_marker;
int max_subrecord_length;
}
@ -550,6 +551,17 @@ export_proto(set_args);
extern void get_args (int *, char ***);
internal_proto(get_args);
extern void store_exe_path (const char *);
export_proto(store_exe_path);
extern char * full_exe_path (void);
internal_proto(full_exe_path);
/* backtrace.c */
extern void show_backtrace (void);
internal_proto(show_backtrace);
/* error.c */
#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)

View file

@ -0,0 +1,333 @@
/* Copyright (C) 2006 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with libgfortran; see the file COPYING. If not, write to
the Free Software Foundation, 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "config.h"
#include <stdio.h>
#include <string.h>
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_INTPTR_T
# define INTPTR_T intptr_t
#else
# define INTPTR_T int
#endif
#ifdef HAVE_EXECINFO_H
#include <execinfo.h>
#endif
#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#include <ctype.h>
#include "libgfortran.h"
#ifndef HAVE_STRCASESTR
#define HAVE_STRCASESTR 1
static char *
strcasestr (const char *s1, const char *s2)
{
const char *p = s1;
const size_t len = strlen (s2);
const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
: (islower((int) *s2) ? toupper((int) *s2)
: *s2);
while (1)
{
while (*p != u && *p != v && *p)
p++;
if (*p == 0)
return NULL;
if (strncasecmp (p, s2, len) == 0)
return (char *)p;
}
}
#endif
#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
&& defined(HAVE_WAIT))
#define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
&& defined(HAVE_BACKTRACE_SYMBOLS))
#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
&& defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
&& defined(HAVE_CLOSE))
#if GLIBC_BACKTRACE
static void
dump_glibc_backtrace (int depth, char *str[])
{
int i;
for (i = 0; i < depth; i++)
st_printf (" + %s\n", str[i]);
free (str);
}
#endif
/* show_backtrace displays the backtrace, currently obtained by means of
the glibc backtrace* functions. */
void
show_backtrace (void)
{
#if GLIBC_BACKTRACE
#define DEPTH 50
#define BUFSIZE 1024
void *trace[DEPTH];
char **str;
int depth;
depth = backtrace (trace, DEPTH);
if (depth <= 0)
return;
str = backtrace_symbols (trace, depth);
#if CAN_PIPE
#ifndef STDIN_FILENO
#define STDIN_FILENO 0
#endif
#ifndef STDOUT_FILENO
#define STDOUT_FILENO 1
#endif
#ifndef STDERR_FILENO
#define STDERR_FILENO 2
#endif
/* We attempt to extract file and line information from addr2line. */
do
{
/* Local variables. */
int f[2], pid, line, i;
FILE *output;
char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
char *p, *end;
const char *addr[DEPTH];
/* Write the list of addresses in hexadecimal format. */
for (i = 0; i < depth; i++)
addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (INTPTR_T) trace[i], addr_buf[i],
sizeof (addr_buf[i]));
/* Don't output an error message if something goes wrong, we'll simply
fall back to the pstack and glibc backtraces. */
if (pipe (f) != 0)
break;
if ((pid = fork ()) == -1)
break;
if (pid == 0)
{
/* Child process. */
#define NUM_FIXEDARGS 5
char *arg[DEPTH+NUM_FIXEDARGS+1];
close (f[0]);
close (STDIN_FILENO);
close (STDERR_FILENO);
if (dup2 (f[1], STDOUT_FILENO) == -1)
_exit (0);
close (f[1]);
arg[0] = (char *) "addr2line";
arg[1] = (char *) "-e";
arg[2] = full_exe_path ();
arg[3] = (char *) "-f";
arg[4] = (char *) "-s";
for (i = 0; i < depth; i++)
arg[NUM_FIXEDARGS+i] = (char *) addr[i];
arg[NUM_FIXEDARGS+depth] = NULL;
execvp (arg[0], arg);
_exit (0);
#undef NUM_FIXEDARGS
}
/* Father process. */
close (f[1]);
wait (NULL);
output = fdopen (f[0], "r");
i = -1;
if (fgets (func, sizeof(func), output))
{
st_printf ("\nBacktrace for this error:\n");
do
{
if (! fgets (file, sizeof(file), output))
goto fallback;
i++;
for (p = func; *p != '\n' && *p != '\r'; p++)
;
*p = '\0';
/* Try to recognize the internal libgfortran functions. */
if (strncasecmp (func, "*_gfortran", 10) == 0
|| strncasecmp (func, "_gfortran", 9) == 0
|| strcmp (func, "main") == 0 || strcmp (func, "_start") == 0)
continue;
if (strcasestr (str[i], "libgfortran.so") != NULL
|| strcasestr (str[i], "libgfortran.dylib") != NULL
|| strcasestr (str[i], "libgfortran.a") != NULL)
continue;
/* If we only have the address, use the glibc backtrace. */
if (func[0] == '?' && func[1] == '?' && file[0] == '?'
&& file[1] == '?')
{
st_printf (" + %s\n", str[i]);
continue;
}
/* Extract the line number. */
for (end = NULL, p = file; *p; p++)
if (*p == ':')
end = p;
if (end != NULL)
{
*end = '\0';
line = atoi (++end);
}
else
line = -1;
if (strcmp (func, "MAIN__") == 0)
st_printf (" + in the main program\n");
else
st_printf (" + function %s (0x%s)\n", func, addr[i]);
if (line <= 0 && strcmp (file, "??") == 0)
continue;
if (line <= 0)
st_printf (" from file %s\n", file);
else
st_printf (" at line %d of file %s\n", line, file);
}
while (fgets (func, sizeof(func), output));
free (str);
return;
fallback:
st_printf ("** Something went wrong while running addr2line. **\n"
"** Falling back to a simpler backtrace scheme. **\n");
}
}
while (0);
#undef DEPTH
#undef BUFSIZE
#endif
#endif
#if CAN_FORK && defined(HAVE_GETPPID)
/* Try to call pstack. */
do
{
/* Local variables. */
int pid;
/* Don't output an error message if something goes wrong, we'll simply
fall back to the pstack and glibc backtraces. */
if ((pid = fork ()) == -1)
break;
if (pid == 0)
{
/* Child process. */
#define NUM_ARGS 2
char *arg[NUM_ARGS+1];
char buf[20];
st_printf ("\nBacktrace for this error:\n");
arg[0] = (char *) "pstack";
snprintf (buf, sizeof(buf), "%d", (int) getppid ());
arg[1] = buf;
arg[2] = NULL;
execvp (arg[0], arg);
#undef NUM_ARGS
/* pstack didn't work, so we fall back to dumping the glibc
backtrace if we can. */
#if GLIBC_BACKTRACE
dump_glibc_backtrace (depth, str);
#else
st_printf (" unable to produce a backtrace, sorry!\n");
#endif
_exit (0);
}
/* Father process. */
wait (NULL);
return;
}
while(0);
#endif
#if GLIBC_BACKTRACE
/* Fallback to the glibc backtrace. */
st_printf ("\nBacktrace for this error:\n");
dump_glibc_backtrace (depth, str);
#endif
}

View file

@ -38,18 +38,20 @@ compile_options_t compile_options;
/* Prototypes */
extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4,
GFC_INTEGER_4);
GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(set_std);
void
set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std,
GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core)
GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core,
GFC_INTEGER_4 backtrace)
{
compile_options.pedantic = pedantic;
compile_options.warn_std = warn_std;
compile_options.allow_std = allow_std;
compile_options.dump_core = dump_core;
compile_options.backtrace = backtrace;
}
@ -64,6 +66,7 @@ init_compile_options (void)
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
compile_options.pedantic = 0;
compile_options.dump_core = 0;
compile_options.backtrace = 0;
}
/* Function called by the front-end to tell us the

View file

@ -542,6 +542,10 @@ static variable variable_table[] = {
init_boolean, show_boolean,
"Dump a core file (if possible) on runtime error", -1},
{"GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace,
init_boolean, show_boolean,
"Print out a backtrace (if possible) on runtime error", -1},
{NULL, 0, NULL, NULL, NULL, NULL, 0}
};

View file

@ -71,6 +71,12 @@ Boston, MA 02110-1301, USA. */
void
sys_exit (int code)
{
/* Show error backtrace if possible. */
if (code != 0 && code != 4
&& (options.backtrace == 1
|| (options.backtrace == -1 && compile_options.backtrace == 1)))
show_backtrace ();
/* Dump core if requested. */
if (code != 0
&& (options.dump_core == 1

View file

@ -32,9 +32,15 @@ Boston, MA 02110-1301, USA. */
#include <string.h>
#include <math.h>
#include <stddef.h>
#include <limits.h>
#include "config.h"
#include "libgfortran.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
/* Stupid function to be sure the constructor is always linked in, even
in the case of static linking. See PR libfortran/22298 for details. */
void
@ -92,6 +98,44 @@ get_args (int *argc, char ***argv)
}
static const char *exe_path;
/* Save the path under which the program was called, for use in the
backtrace routines. */
void
store_exe_path (const char * argv0)
{
#ifndef PATH_MAX
#define PATH_MAX 1024
#endif
#ifndef DIR_SEPARATOR
#define DIR_SEPARATOR '/'
#endif
char buf[PATH_MAX], *cwd, *path;
if (argv0[0] == '/')
{
exe_path = argv0;
return;
}
cwd = getcwd (buf, sizeof (buf));
/* exe_path will be cwd + "/" + argv[0] + "\0" */
path = malloc (strlen (cwd) + 1 + strlen (argv0) + 1);
st_sprintf (path, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
exe_path = path;
}
/* Return the full path of the executable. */
char *
full_exe_path (void)
{
return (char *) exe_path;
}
/* Initialize the runtime library. */
static void __attribute__((constructor))