===================================================================
@@ -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));