diff mbox

[fortran] PR 54833 Don't wrap calls to free(a) in if (a != NULL)

Message ID 507004CC.2000702@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig Oct. 6, 2012, 10:15 a.m. UTC
Hello world,

the attached patch removes wrapping calls to free(a) by
if (a != NULL) for some cases.  It is not complete, because
automatic deallocation of allocatable structure components
is not yet covered.

OK for trunk?

	Thomas

2012-10-06  Thomas König  <tkoenig@gcc.gnu.org>

         PR fortran/54833
         * trans.c (gfc_call_free):  Do not wrap the
         call to __builtin_free in check for NULL.
         (gfc_deallocate_with_status):  For automatic
         deallocation without status, don't wrap call
         to __builtin_free in check for NULL.

2012-10-06  Thomas König  <tkoenig@gcc.gnu.org>

         PR fortran/54833
         * gfortran.dg/auto_dealloc_3.f90:  New test.
diff mbox

Patch

Index: trans.c
===================================================================
--- trans.c	(Revision 191857)
+++ trans.c	(Arbeitskopie)
@@ -814,26 +814,23 @@  gfc_allocate_allocatable (stmtblock_t * block, tre
 }
 
 
-/* Free a given variable, if it's not NULL.  */
+/* Free a given variable.  If it is NULL, free takes care of this
+   automatically.  */
 tree
 gfc_call_free (tree var)
 {
   stmtblock_t block;
-  tree tmp, cond, call;
+  tree call;
 
   if (TREE_TYPE (var) != TREE_TYPE (pvoid_type_node))
     var = fold_convert (pvoid_type_node, var);
 
   gfc_start_block (&block);
   var = gfc_evaluate_now (var, &block);
-  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, var,
-			  build_int_cst (pvoid_type_node, 0));
   call = build_call_expr_loc (input_location,
 			      builtin_decl_explicit (BUILT_IN_FREE),
 			      1, var);
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, call,
-			 build_empty_stmt (input_location));
-  gfc_add_expr_to_block (&block, tmp);
+  gfc_add_expr_to_block (&block, call);
 
   return gfc_finish_block (&block);
 }
@@ -861,11 +858,10 @@  gfc_call_free (tree var)
 	}
     }
 
-   In this front-end version, status doesn't have to be GFC_INTEGER_4.
-   Moreover, if CAN_FAIL is true, then we will not emit a runtime error,
-   even when no status variable is passed to us (this is used for
-   unconditional deallocation generated by the front-end at end of
-   each procedure).
+   In this front-end version, status doesn't have to be GFC_INTEGER_4.  If
+   CAN_FAIL is true and no status variable is passed, we will simply call
+   free(). This is used for unconditional deallocation generated by the
+   front-end at end of each procedure.
    
    If a runtime-message is possible, `expr' must point to the original
    expression being deallocated for its locus and variable name.
@@ -890,6 +886,14 @@  gfc_deallocate_with_status (tree pointer, tree sta
       STRIP_NOPS (pointer);
     }
 
+  if (can_fail && status == NULL_TREE)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_FREE), 1,
+				 fold_convert (pvoid_type_node, pointer));
+      return tmp;
+    }
+
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
 			  build_int_cst (TREE_TYPE (pointer), 0));