gfortran.h (gfc_option_t): Add rtcheck.

2009-03-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
            Paul Thomas  <pault@gcc.gnu.org>
            Tobias Burnus  <burnus@net-b.de>

        * gfortran.h (gfc_option_t): Add rtcheck.
        * lang.opt: New option -fruntime-check.
        * libgfortran.h: Add GFC_RTCHECK_* constants.
        * invoke.texi: Document -fruntime-check.
        * options.c (gfc_handle_runtime_check_option): New function.
        (gfc_init_options,gfc_post_options,gfc_handle_option):
        Add -fruntime-check option.


Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>
Co-Authored-By: Tobias Burnus <burnus@net-b.de>

From-SVN: r145183

gcc/fortran/ChangeLog

+2009-03-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (gfc_option_t): Add rtcheck.
+	* lang.opt: New option -fruntime-check.
+	* libgfortran.h: Add GFC_RTCHECK_* constants.
+	* invoke.texi: Document -fruntime-check.
+	* options.c (gfc_handle_runtime_check_option): New function.
+	(gfc_init_options,gfc_post_options,gfc_handle_option):
+	Add -fruntime-check option.
+
 2009-03-27  Richard Guenther  <rguenther@suse.de>
 
 	* trans-array.c (gfc_conv_descriptor_data_addr): Use

gcc/fortran/gfortran.h

@@ -2008,7 +2008,6 @@ typedef struct
   int flag_automatic;
   int flag_backslash;
   int flag_backtrace;
-  int flag_check_array_temporaries;
   int flag_allow_leading_underscore;
   int flag_dump_core;
   int flag_external_blas;
@@ -2029,6 +2028,7 @@ typedef struct
   int flag_align_commons;
 
   int fpe;
+  int rtcheck;
 
   int warn_std;
   int allow_std;

gcc/fortran/invoke.texi

-@c Copyright (C) 2004, 2005, 2006, 2007, 2008
+@c Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
 @c Free Software Foundation, Inc.
 @c This is part of the GNU Fortran manual.   
 @c For copying conditions, see the file gfortran.texi.
@@ -166,6 +166,7 @@ and warnings}.
 @gccoptlist{-fno-automatic  -ff2c  -fno-underscoring @gol
 -fsecond-underscore @gol
 -fbounds-check -fcheck-array-temporaries  -fmax-array-constructor =@var{n} @gol
+-fcheck=@var{<all|bounds|array-temps>}
 -fmax-stack-var-size=@var{n} @gol
 -fpack-derived  -frepack-arrays  -fshort-enums  -fexternal-blas @gol
 -fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
@@ -1182,13 +1183,31 @@ is implemented as a reference to the link-time external symbol
 for compatibility with @command{g77} and @command{f2c}, and is implied
 by use of the @option{-ff2c} option.
 
-@item -fbounds-check
-@opindex @code{fbounds-check}
+@item -fcheck=@var{<keyword>}
+@opindex @code{fcheck}
 @cindex array, bounds checking
 @cindex bounds checking
 @cindex range checking
 @cindex subscript checking
 @cindex checking subscripts
+@cindex run-time checking
+@cindex checking array temporaries
+
+Enable the generation of run-time checks; the argument shall be
+a comma-delimited list of the following keywords.
+
+@table @asis
+@item @samp{all}
+Enable all run-time test of @option{-fcheck}.
+
+@item @samp{array-temps}
+Warns at run time when for passing an actual argument a temporary array
+had to be generated. The information generated by this warning is
+sometimes useful in optimization, in order to avoid such temporaries.
+
+Note: The warning is only printed once per location.
+
+@item @samp{bounds}
 Enable generation of run-time checks for array subscripts
 and against the declared minimum and maximum values.  It also
 checks array indices for assumed and deferred
@@ -1196,22 +1215,22 @@ shape arrays against the actual allocated bounds and ensures that all string
 lengths are equal for character array constructors without an explicit
 typespec.
 
-Some checks require that @option{-fbounds-check} is set for
+Some checks require that @option{-fcheck=bounds} is set for
 the compilation of the main program.
 
 Note: In the future this may also include other forms of checking, e.g.,
 checking substring references.
+@end table
 
 
-@item fcheck-array-temporaries
-@opindex @code{fcheck-array-temporaries}
-@cindex checking array temporaries
-Warns at run time when for passing an actual argument a temporary array
-had to be generated. The information generated by this warning is
-sometimes useful in optimization, in order to avoid such temporaries.
-
-Note: The warning is only printed once per location.
+@item -fbounds-check
+@opindex @code{fbounds-check}
+@c Note: This option is also referred in gcc's manpage
+Deprecated alias for @option{-fcheck=bounds}.
 
+@item -fcheck-array-temporaries
+@opindex @code{fcheck-array-temporaries}
+Deprecated alias for @option{-fcheck=array-temps}.
 
 @item -fmax-array-constructor=@var{n}
 @opindex @code{fmax-array-constructor}

gcc/fortran/lang.opt

@@ -246,7 +246,7 @@ Fortran RejectNegative Joined UInteger
 
 ffpe-trap=
 Fortran RejectNegative JoinedOrMissing
--ffpe-trap=[..]	Stop on following floating point exceptions
+-ffpe-trap=[...]	Stop on following floating point exceptions
 
 ffree-form
 Fortran RejectNegative
@@ -340,6 +340,10 @@ frepack-arrays
 Fortran
 Copy array sections into a contiguous block on procedure entry
 
+fcheck=
+Fortran RejectNegative JoinedOrMissing
+-fcheck=[...]	Specify which runtime checks are to be performed
+
 fsecond-underscore
 Fortran
 Append a second underscore if the name already contains an underscore

gcc/fortran/libgfortran.h

 /* Header file to the Fortran front-end and runtime library
-   Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -40,6 +40,15 @@ along with GCC; see the file COPYING3.  If not see
 #define GFC_FPE_PRECISION  (1<<5)
 
 
+/* Bitmasks for the various runtime checks that can be enabled.  */
+#define GFC_RTCHECK_BOUNDS      (1<<0)
+#define GFC_RTCHECK_ARRAY_TEMPS (1<<1)
+#define GFC_RTCHECK_RECURSION   (1<<2)
+#define GFC_RTCHECK_DO          (1<<3)
+#define GFC_RTCHECK_ALL        (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \
+				| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO)
+
+
 /* Possible values for the CONVERT I/O specifier.  */
 typedef enum
 {

gcc/fortran/options.c

 /* Parse and display command line options.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -106,7 +106,6 @@ gfc_init_options (unsigned int argc, const char **argv)
   gfc_option.flag_backslash = 0;
   gfc_option.flag_module_private = 0;
   gfc_option.flag_backtrace = 0;
-  gfc_option.flag_check_array_temporaries = 0;
   gfc_option.flag_allow_leading_underscore = 0;
   gfc_option.flag_dump_core = 0;
   gfc_option.flag_external_blas = 0;
@@ -125,6 +124,7 @@ gfc_init_options (unsigned int argc, const char **argv)
   gfc_option.flag_align_commons = 1;
   
   gfc_option.fpe = 0;
+  gfc_option.rtcheck = 0;
 
   /* Argument pointers cannot point to anything but their argument.  */
   flag_argument_noalias = 3;
@@ -232,6 +232,10 @@ gfc_post_options (const char **pfilename)
   if (flag_whole_program)
     gfc_fatal_error ("Option -fwhole-program is not supported for Fortran");
 
+  /* -fbounds-check is equivalent to -fcheck=bounds */
+  if (flag_bounds_check)
+    gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
+
   /* Verify the input file name.  */
   if (!filename || strcmp (filename, "-") == 0)
     {
@@ -449,6 +453,43 @@ gfc_handle_fpe_trap_option (const char *arg)
 }
 
 
+static void
+gfc_handle_runtime_check_option (const char *arg)
+{
+  int result, pos = 0, n;
+  static const char * const optname[] = { "all", "bounds", "array-temps",
+					  /* "recursion", "do", */ NULL };
+  static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
+				 GFC_RTCHECK_ARRAY_TEMPS,
+				 /* GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO, */
+				 0 };
+ 
+  while (*arg)
+    {
+      while (*arg == ',')
+	arg++;
+
+      while (arg[pos] && arg[pos] != ',')
+	pos++;
+
+      result = 0;
+      for (n = 0; optname[n] != NULL; n++)
+	{
+	  if (optname[n] && strncmp (optname[n], arg, pos) == 0)
+	    {
+	      gfc_option.rtcheck |= optmask[n];
+	      arg += pos;
+	      pos = 0;
+	      result = 1;
+	      break;
+	    }
+	}
+      if (!result)
+	gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
+    }
+}
+
+
 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
    recognized and handled.  */
 
@@ -548,7 +589,7 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       break;
       
     case OPT_fcheck_array_temporaries:
-      gfc_option.flag_check_array_temporaries = value;
+      gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
       break;
       
     case OPT_fdump_core:
@@ -845,6 +886,11 @@ gfc_handle_option (size_t scode, const char *arg, int value)
     case OPT_falign_commons:
       gfc_option.flag_align_commons = value;
       break;
+
+    case OPT_fcheck_:
+      gfc_handle_runtime_check_option (arg);
+      break;
+
     }
 
   return result;

gcc/fortran/trans-array.c

 /* Array translation routines
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
    Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
@@ -1058,7 +1058,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 	  gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind,
 				 se->string_length, se->expr, expr->ts.kind);
 	}
-      if (flag_bounds_check && !typespec_chararray_ctor)
+      if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !typespec_chararray_ctor)
 	{
 	  if (first_len)
 	    {
@@ -1761,8 +1761,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   typespec_chararray_ctor = (ss->expr->ts.cl
 			     && ss->expr->ts.cl->length_from_typespec);
 
-  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER
-      && !typespec_chararray_ctor)
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+      && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
     {  
       first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
       first_len = true;
@@ -1880,7 +1880,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
     gcc_assert (INTEGER_CST_P (offset));
 #if 0
   /* Disable bound checking for now because it's probably broken.  */
-  if (flag_bounds_check)
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
     {
       gcc_unreachable ();
     }
@@ -2233,7 +2233,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
   char *msg;
   const char * name = NULL;
 
-  if (!flag_bounds_check)
+  if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
     return index;
 
   index = gfc_evaluate_now (index, &se->pre);
@@ -2469,7 +2469,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
       gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
       gfc_add_block_to_block (&se->pre, &indexse.pre);
 
-      if (flag_bounds_check)
+      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
 	{
 	  /* Check array bounds.  */
 	  tree cond;
@@ -3015,7 +3015,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
     }
 
   /* The rest is just runtime bound checking.  */
-  if (flag_bounds_check)
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
     {
       stmtblock_t block;
       tree lbound, ubound;
@@ -4332,7 +4332,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
       && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
     gfc_conv_string_length (sym->ts.cl, NULL, &block);
 
-  checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check);
+  checkparm = (sym->as->type == AS_EXPLICIT
+	       && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
 
   no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
                 || GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc));
@@ -5329,7 +5330,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
 
       se->expr = ptr;
 
-      if (gfc_option.flag_check_array_temporaries)
+      if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS)
 	{
 	  char * msg;
 

gcc/fortran/trans-decl.c

@@ -3777,7 +3777,8 @@ gfc_generate_function_code (gfc_namespace * ns)
 
       array = tree_cons (NULL_TREE,
 			 build_int_cst (integer_type_node,
-					flag_bounds_check), array);
+					(gfc_option.rtcheck
+					 & GFC_RTCHECK_BOUNDS)), array);
 
       array = tree_cons (NULL_TREE,
 			 build_int_cst (integer_type_node,

gcc/fortran/trans-expr.c

@@ -398,7 +398,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
   if (!CONSTANT_CLASS_P (end.expr) && !DECL_P (end.expr))
     end.expr = gfc_evaluate_now (end.expr, &se->pre);
 
-  if (flag_bounds_check)
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
     {
       tree nonempty = fold_build2 (LE_EXPR, boolean_type_node,
 				   start.expr, end.expr);
@@ -2988,7 +2988,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	{
 	  if (sym->attr.dimension)
 	    {
-	      if (flag_bounds_check)
+	      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
 		{
 		  /* Check the data pointer hasn't been modified.  This would
 		     happen in a function returning a pointer.  */

gcc/fortran/trans-intrinsic.c

@@ -759,7 +759,7 @@ gfc_trans_same_strlen_check (const char* intr_name, locus* where,
   tree name;
 
   /* If bounds-checking is disabled, do nothing.  */
-  if (!flag_bounds_check)
+  if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
     return;
 
   /* Compare the two string lengths.  */
@@ -885,7 +885,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
     }
   else
     {
-      if (flag_bounds_check)
+      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
         {
           bound = gfc_evaluate_now (bound, &se->pre);
           cond = fold_build2 (LT_EXPR, boolean_type_node,

gcc/fortran/trans-stmt.c

@@ -2258,10 +2258,10 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
       loop.array_parameter = 1;
 
       /* Calculate the bounds of the scalarization.  */
-      save_flag = flag_bounds_check;
-      flag_bounds_check = 0;
+      save_flag = gfc_option.rtcheck;
+      gfc_option.rtcheck &= !GFC_RTCHECK_BOUNDS;
       gfc_conv_ss_startstride (&loop);
-      flag_bounds_check = save_flag;
+      gfc_option.rtcheck = save_flag;
       gfc_conv_loop_setup (&loop, &expr2->where);
 
       /* Figure out how many elements we need.  */