re PR fortran/42958 (Weird temporary array allocation)

2010-02-20  Tobias Burnus  <burnus@net-b.de>

        PR fortran/42958
        * libgfortran.h: Add GFC_RTCHECK_MEM.
        * invoke.texi (-fcheck=): Document -fcheck=mem.
        * tranc.c (gfc_call_malloc): Remove negative-size run-time error
        and enable malloc-success check only with -fcheck=mem.
        * option.c (gfc_handle_runtime_check_option): Add -fcheck=mem.

From-SVN: r156923

gcc/fortran/ChangeLog

@@ -1,3 +1,12 @@
+2010-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42958
+	* libgfortran.h: Add GFC_RTCHECK_MEM.
+	* invoke.texi (-fcheck=): Document -fcheck=mem.
+	* tranc.c (gfc_call_malloc): Remove negative-size run-time error
+	and enable malloc-success check only with -fcheck=mem.
+	* option.c (gfc_handle_runtime_check_option): Add -fcheck=mem.
+
 2010-02-16  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/43040

gcc/fortran/invoke.texi

@@ -166,7 +166,7 @@ and warnings}.
 @gccoptlist{-fno-automatic  -ff2c  -fno-underscoring @gol
 -fwhole-file -fsecond-underscore @gol
 -fbounds-check -fcheck-array-temporaries  -fmax-array-constructor =@var{n} @gol
--fcheck=@var{<all|array-temps|bounds|do|pointer|recursion>}
+-fcheck=@var{<all|array-temps|bounds|do|mem|pointer|recursion>}
 -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
@@ -1216,6 +1216,7 @@ by use of the @option{-ff2c} option.
 @cindex array, bounds checking
 @cindex bounds checking
 @cindex pointer checking
+@cindex memory checking
 @cindex range checking
 @cindex subscript checking
 @cindex checking subscripts
@@ -1254,6 +1255,11 @@ checking substring references.
 Enable generation of run-time checks for invalid modification of loop
 iteration variables.
 
+@item @samp{mem}
+Enable generation of run-time checks for memory allocation.
+Note: This option does not affect explicit allocations using the
+@code{ALLOCATE} statement, which will be always checked.
+
 @item @samp{pointer}
 Enable generation of run-time checks for pointers and allocatables.
 

gcc/fortran/libgfortran.h

@@ -48,9 +48,10 @@ along with GCC; see the file COPYING3.  If not see
 #define GFC_RTCHECK_RECURSION   (1<<2)
 #define GFC_RTCHECK_DO          (1<<3)
 #define GFC_RTCHECK_POINTER     (1<<4)
+#define GFC_RTCHECK_MEM         (1<<5)
 #define GFC_RTCHECK_ALL        (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \
 				| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \
-				| GFC_RTCHECK_POINTER)
+				| GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM)
 
 
 /* Possible values for the CONVERT I/O specifier.  */

gcc/fortran/options.c

@@ -482,11 +482,12 @@ gfc_handle_runtime_check_option (const char *arg)
 {
   int result, pos = 0, n;
   static const char * const optname[] = { "all", "bounds", "array-temps",
-					  "recursion", "do", "pointer", NULL };
+					  "recursion", "do", "pointer",
+					  "mem", NULL };
   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 				 GFC_RTCHECK_ARRAY_TEMPS,
 				 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
-				 GFC_RTCHECK_POINTER,
+				 GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
 				 0 };
  
   while (*arg)

gcc/fortran/trans.c

@@ -497,13 +497,12 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
 
 
 /* Call malloc to allocate size bytes of memory, with special conditions:
-      + if size < 0, generate a runtime error,
-      + if size == 0, return a malloced area of size 1,
+      + if size <= 0, return a malloced area of size 1,
       + if malloc returns NULL, issue a runtime error.  */
 tree
 gfc_call_malloc (stmtblock_t * block, tree type, tree size)
 {
-  tree tmp, msg, negative, malloc_result, null_result, res;
+  tree tmp, msg, malloc_result, null_result, res;
   stmtblock_t block2;
 
   size = gfc_evaluate_now (size, block);
@@ -514,18 +513,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
   /* Create a variable to hold the result.  */
   res = gfc_create_var (prvoid_type_node, NULL);
 
-  /* size < 0 ?  */
-  negative = fold_build2 (LT_EXPR, boolean_type_node, size,
-			  build_int_cst (size_type_node, 0));
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
-      ("Attempt to allocate a negative amount of memory."));
-  tmp = fold_build3 (COND_EXPR, void_type_node, negative,
-		     build_call_expr_loc (input_location,
-				      gfor_fndecl_runtime_error, 1, msg),
-		     build_empty_stmt (input_location));
-  gfc_add_expr_to_block (block, tmp);
-
-  /* Call malloc and check the result.  */
+  /* Call malloc.  */
   gfc_start_block (&block2);
 
   size = fold_build2 (MAX_EXPR, size_type_node, size,
@@ -535,15 +523,21 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
 		  fold_convert (prvoid_type_node,
 				build_call_expr_loc (input_location,
 				   built_in_decls[BUILT_IN_MALLOC], 1, size)));
-  null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
-			     build_int_cst (pvoid_type_node, 0));
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
-      ("Memory allocation failed"));
-  tmp = fold_build3 (COND_EXPR, void_type_node, null_result,
-		     build_call_expr_loc (input_location,
-				      gfor_fndecl_os_error, 1, msg),
-		     build_empty_stmt (input_location));
-  gfc_add_expr_to_block (&block2, tmp);
+
+  /* Optionally check whether malloc was successful.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEM)
+    {
+      null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
+				 build_int_cst (pvoid_type_node, 0));
+      msg = gfc_build_addr_expr (pchar_type_node,
+	      gfc_build_localized_cstring_const ("Memory allocation failed"));
+      tmp = fold_build3 (COND_EXPR, void_type_node, null_result,
+	      build_call_expr_loc (input_location,
+				   gfor_fndecl_os_error, 1, msg),
+				   build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
+    }
+
   malloc_result = gfc_finish_block (&block2);
 
   gfc_add_expr_to_block (block, malloc_result);
@@ -553,6 +547,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
   return res;
 }
 
+
 /* Allocate memory, using an optional status argument.
  
    This function follows the following pseudo-code: