diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 32 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 11 | ||||
| -rw-r--r-- | gcc/fortran/lang.opt | 4 | ||||
| -rw-r--r-- | gcc/fortran/options.c | 6 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/warn_target_lifetime_1.f90 | 47 |
8 files changed, 115 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e91f947c..de255ea 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2012-08-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/54301 + * expr.c (gfc_check_pointer_assign): Warn when the pointer + might outlive its target. + * gfortran.h (struct gfc_option_t): Add warn_target_lifetime. + * options.c (gfc_init_options, set_wall, gfc_handle_option): + handle it. + * invoke.texi (-Wtarget-lifetime): Document it. + (-Wall): Implied it. + * lang.opt (-Wtarget-lifetime): New flag. + 2012-08-19 Thomas König <tkoenig@gcc.gnu.org> PR fortran/54298 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 7d74528..6f1283d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3659,6 +3659,38 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } } + /* Warn if it is the LHS pointer may lives longer than the RHS target. */ + if (gfc_option.warn_target_lifetime + && rvalue->expr_type == EXPR_VARIABLE + && !rvalue->symtree->n.sym->attr.save + && !attr.pointer && !rvalue->symtree->n.sym->attr.host_assoc + && !rvalue->symtree->n.sym->attr.in_common + && !rvalue->symtree->n.sym->attr.use_assoc + && !rvalue->symtree->n.sym->attr.dummy) + { + bool warn; + gfc_namespace *ns; + + warn = lvalue->symtree->n.sym->attr.dummy + || lvalue->symtree->n.sym->attr.result + || lvalue->symtree->n.sym->attr.host_assoc + || lvalue->symtree->n.sym->attr.use_assoc + || lvalue->symtree->n.sym->attr.in_common; + + if (rvalue->symtree->n.sym->ns->proc_name + && rvalue->symtree->n.sym->ns->proc_name->attr.flavor != FL_PROCEDURE + && rvalue->symtree->n.sym->ns->proc_name->attr.flavor != FL_PROGRAM) + for (ns = rvalue->symtree->n.sym->ns; + ns->proc_name && ns->proc_name->attr.flavor != FL_PROCEDURE; + ns = ns->parent) + if (ns->parent == lvalue->symtree->n.sym->ns) + warn = true; + + if (warn) + gfc_warning ("Pointer at %L in pointer assignment might outlive the " + "pointer target", &lvalue->where); + } + return SUCCESS; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c005151..4c8a856 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2226,6 +2226,7 @@ typedef struct int warn_realloc_lhs; int warn_realloc_lhs_all; int warn_compare_reals; + int warn_target_lifetime; int max_errors; int flag_all_intrinsics; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index d962ca0..dfd4ca7 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -147,7 +147,7 @@ and warnings}. -Wimplicit-procedure -Wintrinsic-shadow -Wintrinsics-std @gol -Wline-truncation -Wno-align-commons -Wno-tabs -Wreal-q-constant @gol -Wsurprising -Wunderflow -Wunused-parameter -Wrealloc-lhs Wrealloc-lhs-all @gol --fmax-errors=@var{n} -fsyntax-only -pedantic -pedantic-errors +-Wtarget-lifetime -fmax-errors=@var{n} -fsyntax-only -pedantic -pedantic-errors } @item Debugging Options @@ -729,8 +729,8 @@ we recommend avoiding and that we believe are easy to avoid. This currently includes @option{-Waliasing}, @option{-Wampersand}, @option{-Wconversion}, @option{-Wcompare-reals}, @option{-Wsurprising}, @option{-Wintrinsics-std}, @option{-Wno-tabs}, @option{-Wintrinsic-shadow}, -@option{-Wline-truncation}, @option{-Wreal-q-constant} and -@option{-Wunused}. +@option{-Wline-truncation}, @option{-Wtarget-lifetime}, +@option{-Wreal-q-constant} and @option{-Wunused}. @item -Waliasing @opindex @code{Waliasing} @@ -941,6 +941,11 @@ allocatable variable; this includes scalars and derived types. Warn when comparing real or complex types for equality or inequality. Enabled by @option{-Wall}. +@item -Wtarget-lifetime +@opindex @code{Wtargt-lifetime} +Warn if the pointer in a pointer assignment might be longer than the its +target. This option is implied by @option{-Wall}. + @item -Werror @opindex @code{Werror} @cindex warnings, to errors diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index e0c7cf7..b38b1e8 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -262,6 +262,10 @@ Wrealloc-lhs-all Fortran Warning Warn when a left-hand-side variable is reallocated +Wtarget-lifetime +Fortran Warning +Warn if the pointer in a pointer assignment might outlive its target + Wreturn-type Fortran Warning ; Documented in C diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 3e4444d..cbec705 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -114,6 +114,7 @@ gfc_init_options (unsigned int decoded_options_count, gfc_option.warn_realloc_lhs = 0; gfc_option.warn_realloc_lhs_all = 0; gfc_option.warn_compare_reals = 0; + gfc_option.warn_target_lifetime = 0; gfc_option.max_errors = 25; gfc_option.flag_all_intrinsics = 0; @@ -475,6 +476,7 @@ set_Wall (int setting) gfc_option.warn_real_q_constant = setting; gfc_option.warn_unused_dummy_argument = setting; gfc_option.warn_compare_reals = setting; + gfc_option.warn_target_lifetime = setting; warn_return_type = setting; warn_switch = setting; @@ -688,6 +690,10 @@ gfc_handle_option (size_t scode, const char *arg, int value, gfc_option.warn_tabs = value; break; + case OPT_Wtarget_lifetime: + gfc_option.warn_target_lifetime = value; + break; + case OPT_Wunderflow: gfc_option.warn_underflow = value; break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1e29433..c115e55 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-08-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/54301 + * gfortran.dg/warn_target_lifetime_1.f90: New. + 2012-08-19 Thomas König <tkoenig@gcc.gnu.org> PR fortran/54298 diff --git a/gcc/testsuite/gfortran.dg/warn_target_lifetime_1.f90 b/gcc/testsuite/gfortran.dg/warn_target_lifetime_1.f90 new file mode 100644 index 0000000..fafa0f1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/warn_target_lifetime_1.f90 @@ -0,0 +1,47 @@ +! { dg-do compile } +! { dg-options "-Wtarget-lifetime" } +! +! PR fortran/54301 +! +function f () result (ptr) + integer, pointer :: ptr(:) + integer, allocatable, target :: a(:) + allocate(a(5)) + + ptr => a ! { dg-warning "Pointer at .1. in pointer assignment might outlive the pointer target" } + a = [1,2,3,4,5] +end function + + +subroutine foo() + integer, pointer :: ptr(:) + call bar () +contains + subroutine bar () + integer, target :: tgt(5) + ptr => tgt ! { dg-warning "Pointer at .1. in pointer assignment might outlive the pointer target" } + end subroutine bar +end subroutine foo + +function foo3(tgt) + integer, target :: tgt + integer, pointer :: foo3 + foo3 => tgt +end function + +subroutine sub() + implicit none + integer, pointer :: ptr + integer, target :: tgt + ptr => tgt + + block + integer, pointer :: p2 + integer, target :: tgt2 + p2 => tgt2 + p2 => tgt + ptr => p2 + ptr => tgt + ptr => tgt2 ! { dg-warning "Pointer at .1. in pointer assignment might outlive the pointer target" } + end block +end subroutine sub |