cl->passed_length,
fold_convert (gfc_charlen_type_node,
integer_zero_node));
- not_absent = fold_build2 (NE_EXPR, boolean_type_node,
- fsym->backend_decl, null_pointer_node);
+ /* The symbol needs to be referenced for gfc_get_symbol_decl. */
+ fsym->attr.referenced = 1;
+ not_absent = gfc_conv_expr_present (fsym);
absent_failed = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
not_0length, not_absent);
stmtblock_t block;
stmtblock_t body;
tree result;
- tree recurcheckvar = NULL;
+ tree recurcheckvar = NULL_TREE;
gfc_symbol *sym;
int rank;
bool is_recursive;
is_recursive = sym->attr.recursive
|| (sym->attr.entry_master
&& sym->ns->entries->sym->attr.recursive);
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive
- && !gfc_option.flag_recursive)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_recursive)
{
char * msg;
}
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
- && sym->attr.subroutine)
+ && sym->attr.subroutine)
{
tree alternate_return;
alternate_return = gfc_get_fake_result_decl (sym, 0);
else
result = sym->result->backend_decl;
- if (result != NULL_TREE && sym->attr.function
- && !sym->attr.pointer)
+ if (result != NULL_TREE
+ && sym->attr.function
+ && !sym->attr.pointer)
{
if (sym->ts.type == BT_DERIVED
&& sym->ts.u.derived->attr.alloc_comp)
gfc_add_expr_to_block (&block, tmp);
/* Reset recursion-check variable. */
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive
- && !gfc_option.flag_openmp)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_openmp
+ && recurcheckvar != NULL_TREE)
{
gfc_add_modify (&block, recurcheckvar, boolean_false_node);
recurcheckvar = NULL;
{
gfc_add_expr_to_block (&block, tmp);
/* Reset recursion-check variable. */
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive
- && !gfc_option.flag_openmp)
- {
- gfc_add_modify (&block, recurcheckvar, boolean_false_node);
- recurcheckvar = NULL;
- }
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_openmp
+ && recurcheckvar != NULL_TREE)
+ {
+ gfc_add_modify (&block, recurcheckvar, boolean_false_node);
+ recurcheckvar = NULL_TREE;
+ }
}
--- /dev/null
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Test the fix for PR42783, in which a bogus array bounds violation
+! with missing optional array argument.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug99
+ implicit none
+ character(len=8), parameter :: mnem_list(2) = "A"
+
+ call foo (mnem_list) ! This call succeeds
+ call foo () ! This call fails
+contains
+ subroutine foo (mnem_list)
+ character(len=8) ,intent(in) ,optional :: mnem_list(:)
+
+ integer :: i,j
+ character(len=256) :: ml
+ ml = ''
+ j = 0
+ if (present (mnem_list)) then
+ do i = 1, size (mnem_list)
+ if (mnem_list(i) /= "") then
+ j = j + 1
+ if (j > len (ml)/8) call abort ()
+ ml((j-1)*8+1:(j-1)*8+8) = mnem_list(i)
+ end if
+ end do
+ end if
+ if (j > 0) print *, trim (ml(1:8))
+ end subroutine foo
+end program gfcbug99