[Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 972 bytes --]

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

[-- Attachment #2: pointer-outlive.diff --]
[-- Type: text/x-patch, Size: 6594 bytes --]

2012-08-19  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  Tobias Burnus  <burnus@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

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Thomas Koenig]

Hi Tobias,

> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?

I would exclude pointers on the lhs of the pointer assignment, to make
sure that warnings for code such as

program main
   integer :: i
   integer, pointer :: ip
   block
     integer, pointer :: jp
     allocate (jp)
     jp = 3
     ip => jp
   end block
   i = ip
   print *,i
end program main

are not emitted.

	Thomas

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Tobias Burnus]

Am 19.08.2012 21:19, schrieb Thomas Koenig:
>> Build and regtested on x86-64-gnu-linux.
>> OK for the trunk?
>
> I would exclude pointers on the lhs of the pointer assignment,

I assume you mean RHS – excluding LHS pointers in pointer assignments is 
kind of difficult ;-)

RHS pointers are excluded via:

+ 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

the attr is set via:
attr = gfc_expr_attr (rvalue);

> to make sure that warnings for code such as
> are not emitted.

There is no warning with the patch.

Tobias

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Thomas Koenig]

Hi Tobias,

> Am 19.08.2012 21:19, schrieb Thomas Koenig:
>>> Build and regtested on x86-64-gnu-linux.
>>> OK for the trunk?
>>
>> I would exclude pointers on the lhs of the pointer assignment,
>
> I assume you mean RHS – excluding LHS pointers in pointer assignments is
> kind of difficult ;-)

Sometimes I have a weak right-left weakness :-)

> RHS pointers are excluded via:

...

> There is no warning with the patch.

OK for trunk then.  You'll find your patch no longer applies
cleanly, because I have changed the same spot(s) in invoke.texi
and gfortran.h with my recent commit, but I think you'll manage :-)

	Thomas

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 323 bytes --]

Am 19.08.2012 23:59, schrieb Thomas Koenig:
> OK for trunk then.  You'll find your patch no longer applies
> cleanly, because I have changed the same spot(s) in invoke.texi
> and gfortran.h with my recent commit, but I think you'll manage :-)

Thanks for the review. I committed the re-diffed patch as Rev. 190522.

Tobias

[-- Attachment #2: pointer-outlive-v2.diff --]
[-- Type: text/x-patch, Size: 6675 bytes --]

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-20  Tobias Burnus  <burnus@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..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..e796ffe 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
   unsigned select_type_temporary:1;
@@ -2226,6 +2231,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;
--- /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

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Thomas Koenig]

Hi Tobias,

do you think that -Wtarget-lifetime should be included with -Wall?
I think so, because the code flagged is certainly invalid, and likely
to cause random errors.

	Thomas

Re: [Patch, Fortran] PR54301 - add warning for pointer might outlive its target

[Tobias Burnus]

Hi Thomas,

Thomas Koenig wrote:
> do you think that -Wtarget-lifetime should be included with -Wall?
> I think so, because the code flagged is certainly invalid, and likely
> to cause random errors.

I concur. However, that's what the current version in the trunk does: 
-Wall implies -Wtarget-lifetime.

On the other hand, I just realized that "attr.result" is not set if the 
function symbols is also its result symbol – hence, there is no warning for:

function f()
   integer, pointer :: f
   integer, target :: t
   f => t
end

I think the following patch will fix that. I will package, regtest and 
commit it later.

Tobias

--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3673,6 +3673,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, 
gfc_expr *rvalue)

        warn = lvalue->symtree->n.sym->attr.dummy
              || lvalue->symtree->n.sym->attr.result
+            || lvalue->symtree->n.sym->attr.function
              || lvalue->symtree->n.sym->attr.host_assoc
              || lvalue->symtree->n.sym->attr.use_assoc
              || lvalue->symtree->n.sym->attr.in_common;