As suggested in the draft Fortran appendix to ISO/IEC Technical Report
24772 "Guidance for Avoiding Vulnerabilities through Language Selection
and Use"*
"Future standardization efforts should consider:"
...
"* Requiring that processors have the ability to detect and report the
occurrence within a submitted program unit of pointer assignment of
a pointer whose lifetime is known to be longer than the lifetime of the
target."
The new flag -Wtarget-lifetime implements this; it is enabled by -Wall.
(Well, at least kind of; the suggested requirement is only implementable
by a complicated run-time check. However, the attached compile-time
warning is a good approximation, which should help to find real bugs
with only few false positives.)
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
* See
http://gcc.gnu.org/wiki/GFortranStandards#ISO.2BAC8-IEC_Project_22.24772:_Guidance_for_Avoiding_Vulnerabilities_through_Language_Selection_and_Use
2012-08-19 Tobias Burnus <bur...@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 Tobias Burnus <bur...@net-b.de>
PR fortran/54301
* gfortran.dg/warn_target_lifetime_1.f90: New.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7d74528..d94afb7 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3659,6 +3659,37 @@ 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)
+ 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 7c4c0a4..308dbc1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
unsigned select_type_temporary:1;
@@ -2225,6 +2226,7 @@ typedef struct
int warn_unused_dummy_argument;
int warn_realloc_lhs;
int warn_realloc_lhs_all;
+ int warn_target_lifetime;
int max_errors;
int flag_all_intrinsics;
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 658ed23..edd9183 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,7 +729,7 @@ we recommend avoiding and that we believe are easy to avoid.
This currently includes @option{-Waliasing}, @option{-Wampersand},
@option{-Wconversion}, @option{-Wsurprising}, @option{-Wintrinsics-std},
@option{-Wno-tabs}, @option{-Wintrinsic-shadow}, @option{-Wline-truncation},
-@option{-Wreal-q-constant} and @option{-Wunused}.
+@option{-Wreal-q-constant}, @option{-Wtarget-lifetime} and @option{-Wunused}.
@item -Waliasing
@opindex @code{Waliasing}
@@ -935,6 +935,11 @@ a scalar. See also @option{-frealloc-lhs}.
Warn when the compiler inserts code to for allocation or reallocation of an
allocatable variable; this includes scalars and derived types.
+@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 3b9d29b..a721187 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -258,6 +258,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 64d4da1..b40ffaa 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -113,6 +113,7 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.warn_unused_dummy_argument = 0;
gfc_option.warn_realloc_lhs = 0;
gfc_option.warn_realloc_lhs_all = 0;
+ gfc_option.warn_target_lifetime = 0;
gfc_option.max_errors = 25;
gfc_option.flag_all_intrinsics = 0;
@@ -473,6 +474,7 @@ set_Wall (int setting)
gfc_option.warn_character_truncation = setting;
gfc_option.warn_real_q_constant = setting;
gfc_option.warn_unused_dummy_argument = setting;
+ gfc_option.warn_target_lifetime = setting;
warn_return_type = setting;
warn_switch = setting;
@@ -682,6 +684,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;
--- /dev/null 2012-08-16 07:16:46.391724752 +0200
+++ gcc/gcc/testsuite/gfortran.dg/warn_target_lifetime_1.f90 2012-08-19 16:12:58.000000000 +0200
@@ -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
