Hi Yuao,
Yuao Ma wrote:
===============================
@@ -6709,0 +6733,6 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym,
+ else if (e->expr_type == EXPR_CONDITIONAL)
+ {
+ gcc_assert (parmse && TREE_CODE (parmse->expr) == COND_EXPR);
+ tree cond = TREE_OPERAND (parmse->expr, 0);
+ vec_safe_push (optionalargs, fold_convert (boolean_type_node, cond));
+ }
===============================
IIUC, this approach won't work for a simple case like (.false. ? .nil.
: 1). We ultimately need to know if the value is .nil. or not, rather
than just checking the first condition. Since this seems similar to
how EXPR_VARIABLE is handled, I've just reused that logic.
Hmm, this one is indeed slightly tricky. If there is no .NIL.
and no allocatable/pointer is passed to a non-allocatable/non-pointer,
then the proper call would be:
sub2(cond ? *a : *b, 1)
but what we get is the following:
D.4678 = cond;
D.4679 = cond;
D.4681 = D.4679 ? (integer(kind=4) *) a != 0B : (integer(kind=4) *) b != 0B ?
D.4678 ? *a : *b : condtemp.0;
sub2 (D.4681, D.4679 ? (integer(kind=4) *) a != 0B : (integer(kind=4) *) b !=
0B);
Admittedly, due to:
"integer(kind=4) & restrict a, integer(kind=4) & restrict b"
the middle end knows that 'a' and 'b' cannot be NULL and, hence,
the compiler can optimize it (and will with -O1 and higher).
Ignoring alloctables/pointers for the moment, I think we could
do
if (e->expr_type == EXPR_CONDITIONAL
&& !gfc_conditional_expr_with_nil (e))
is_present = true;
else ...
or keep your current code:
/* F2018:15.5.2.12 Argument presence and
restrictions on arguments not present. */
- if (e->expr_type == EXPR_VARIABLE
- && e->rank == 0
- && (gfc_expr_attr (e).allocatable
- || gfc_expr_attr (e).pointer))
+ if ((e->expr_type == EXPR_VARIABLE && e->rank == 0
+ && (gfc_expr_attr (e).allocatable || gfc_expr_attr (e).pointer))
+ || e->expr_type == EXPR_CONDITIONAL)
{
But with an updated comment - explaining why EXPR_CONDITIONAL
is here (because of .NIL. - and the non-nil parts will be optimized
away by the middle end).
* * *
HOWEVER, there is something in addition:
* Disassociated pointers and deallocated allocatables also
count as absent (when passing them to a dummy argument
that is optional but neither pointer or allocatable).
* Passing absent arguments on also count as, well, absent.
* allocatable/pointer + optional can be combined
* * *
In any case, there is something not quite right in this
area, as shown by the attached test cases.
(A) conditional-expr-3.f90 - this one shows that
call sub()
...
subroutine sub(x)
integer, OPTIONAL, VALUE :: x
logical :: cond = .true.
call test ( (cond ? x : .nil.) )
...
subroutine test(y)
integer, OPTIONAL, VALUE :: y
print *, present(y) ! Prints T
is mishandled by printing 'true' despite
'call sub()' lacking an argument.
* * *
(B) I think this is about absent + allocatable/pointer,
but I have not fully checked. In any case, if
I comment in any of the 'FIXME' lines,
I get a segfault with:
conditional-expr-1.f90
conditional-expr-2.f90 uses character strings and
is presumably fine, once expr-1 is fixed.
* * *
(C) Missing feature, also shown in
conditional-expr-1.f90
Namely, a conditional argument can be an ALLOCATABLE
or POINTER - if all its expressions are ALLOCATABLE
or all are POINTER.
Obviously, this only matters when passing a conditional
argument as actual argument to a dummy argument that
requires an allocatable or a pointer.
[And it can be combined with .NIL. if that dummy argument
is also 'optional'.]
I think it can be handled later on - but as it affects
how optional is handled, it might make sense to handle
it already with this patch.
In any case, I wanted to mention it.
* * *
Subject: [PATCH] fortran: support .NIL. in conditional arguments
This patch introduces support for the NIL value within a conditional arguments,
addressing several scenarios for how NIL should be handled.
I think NIL should be .NIL.
Otherwise, this does not really add anything to the subject line,
but it is also not really wrong. (Keep it or remove it as you like.)
* * *
BTW: If you think it should be best handled incrementally, one option
would be to add a 'sorry' error – and handle those later.
I think we need a sorry for code that is known to produce
invalid code. - For bogus errors (like 'call sub((c ? allocvar:allocvar2))'
not being rejected as not allocatable), it is not strictly required.
Reason: While the error is bogus, it does not compile and, hence,
there is no issue with silently generating wrong code.
If you go for that route, I think we want to have a sorry
for the FIXME issues in expr-1 and those in expr-3. And for
the code in 'conv_dummy_value', I think a comment would be good
why that's called for conditional expr, possibly with a FIXME
about the missing bits.
Tobias
! { dg-do run }
! { dg-additional-options "-g" }
module m
implicit none (type, external)
logical :: is_present
logical :: is_allocated
integer :: has_value
contains
subroutine test(a,c, cond)
integer, allocatable :: a,c
logical, value :: cond
call sub(( cond ? a : c))
call sub_val(( cond ? a : c))
!call sub_alloc(( cond ? a : c)) ! -> BOGUS ERROR: Actual argument for 'x' must be ALLOCATABLE
end
subroutine test2(a,c, cond)
integer, allocatable, optional :: a,c
logical, value :: cond
call sub(( cond ? a : c))
call sub_val(( cond ? a : c))
! call sub_alloc(( cond ? a : c)) ! -> BOGUS ERROR: Actual argument for 'x' must be ALLOCATABLE
end
subroutine test_nil(a, cond)
integer, allocatable :: a
logical, value :: cond
call sub(( cond ? a : .nil.))
call sub(( .not.cond ? .nil. : a))
call sub_val(( cond ? a : .nil.))
call sub_val(( .not.cond ? .nil. : a))
! call sub_alloc(( cond ? a : .nil.)) ! -> BOGUS ERROR: Actual argument for 'x' must be ALLOCATABLE
! call sub_alloc(( .not.cond ? .nil. : a)) ! Likewise
end
subroutine test2_nil(a, cond)
integer, allocatable, optional :: a
logical, value :: cond
call sub(( cond ? a : .nil.))
call sub(( .not.cond ? .nil. : a))
call sub_val(( cond ? a : .nil.))
call sub_val(( .not.cond ? .nil. : a))
!call sub_alloc(( cond ? a : .nil.)) ! -> BOGUS ERROR: Actual argument for 'x' must be ALLOCATABLE
!call sub_alloc(( .not.cond ? .nil. : a)) ! Likewise
end
subroutine sub(x)
integer, optional :: x
if (present(x) .neqv. (is_present .and. is_allocated)) error stop
if (present(x)) then
if (x /= has_value) error stop
end if
! print *, present(x)
! if (present(x)) print *, x
end
subroutine sub_val(x)
integer, optional, value :: x
if (present(x) .neqv. (is_present .and. is_allocated)) error stop
if (present(x)) then
if (x /= has_value) error stop
end if
! print *, present(x)
! if (present(x)) print *, x
end
subroutine sub_alloc(x)
integer, allocatable, optional :: x
if (present(x) .neqv. is_present) error stop
if (present(x)) then
if (allocated(x) .neqv. is_allocated) error stop
if (allocated(x)) then
if (x /= has_value) error stop
end if
end if
! print *, present(x)
! if (present(x)) print *, x
end
end
use m
implicit none (type, external)
integer, allocatable :: b,d
is_allocated = .false.
is_present = .true.
call test(b, d, .true.)
call test(b, d, .false.)
call test_nil(b, .true.)
call test_nil(b, .false.)
is_present = .true.
call test2(b, cond=.true.)
call test2_nil(b, cond=.true.)
!call test2(c=d, cond=.false.) ! FIXME: Segfaults
is_present = .false.
!call test2(b, cond=.false.) ! FIXME: Segfaults
!call test2(c=d, cond=.true.) ! FIXME: Segfaults
call test2_nil(b, cond=.false.)
!call test2_nil(cond=.true.) ! FIXME: Segfaults
!call test2_nil(cond=.false.) ! FIXME: Segfaults
b = 4
is_present = .true.
is_allocated = .true.
has_value = 4
call test(b, d, .true.)
call test2(b, d, cond=.true.)
call test2(b, cond=.true.)
is_allocated = .false.
call test(b, d, .false.)
call test2(b, d, cond=.false.)
!call test2(b, cond=.false.) ! FIXME: Segfaults
is_present = .false.
!call test2(c=b, cond=.true.) ! FIXME: Segfaults
is_present = .true.
is_allocated = .true.
!call test2(c=b, cond=.false.) ! FIXME: Segfaults
deallocate(b)
d = 5
is_present = .true.
is_allocated = .false.
call test(b, d, .true.)
call test2(b, d, cond=.true.)
is_allocated = .true.; has_value = 5
call test(b, d, .false.)
call test2(b, d, cond=.false.)
b = 6
is_allocated = .true.; has_value = 6
call test(b, d, .true.)
call test2(b, d, cond=.true.)
is_allocated = .true.; has_value = 5
call test(b, d, .false.)
call test2(b, d, cond=.false.)
is_allocated = .true.; has_value = 6
call test_nil(b, .true.)
call test2_nil(b, cond=.true.)
is_present = .false.
call test_nil(b, .false.)
call test2_nil(b, cond=.false.)
deallocate(b,d)
end
! { dg-do run }
! { dg-additional-options "-g" }
module m
implicit none (type, external)
logical :: is_present
character(1), pointer :: has_value1 => null()
character(:), pointer :: has_value => null()
contains
subroutine test(a,c,a1,c1, cond)
character(:), allocatable :: a,c
character(1), allocatable :: a1,c1
logical, value :: cond
call sub(( cond ? a : c))
call sub_val(( cond ? a1 : c1))
end
subroutine test2(a,c,a1,c1, cond)
character(:), allocatable, optional :: a,c
character(1), allocatable, optional :: a1,c1
logical, value :: cond
call sub(( cond ? a : c))
call sub_val(( cond ? a1 : c1))
end
subroutine test_nil(a,a1, cond)
character(:), allocatable :: a
character(1), allocatable :: a1
logical, value :: cond
call sub(( cond ? a : .nil.))
call sub_val(( cond ? a1 : .nil.))
call sub(( .not.cond ? .nil. : a))
call sub_val(( .not.cond ? .nil. : a1))
end
subroutine test2_nil(a,a1, cond)
character(:), allocatable, optional :: a
character(1), allocatable, optional :: a1
logical, value :: cond
call sub(( cond ? a : .nil.))
call sub_val(( cond ? a1 : .nil.))
call sub(( .not.cond ? .nil. : a))
call sub_val(( .not.cond ? .nil. : a1))
end
subroutine sub(x)
character(*), optional :: x
if (present(x) .neqv. is_present) error stop
if (present(x)) then
if (len(x) /= len(has_value)) error stop
if (x /= has_value) error stop
end if
! print *, present(x)
! if (present(x)) print *, x
end
subroutine sub_Val(x)
character(1), optional, value :: x
if (present(x) .neqv. is_present) error stop
if (present(x)) then
if (x /= has_value1) error stop
end if
! print *, present(x)
! if (present(x)) print *, x
end
end
program main
use m
implicit none (type, external)
character(:), allocatable, target :: b,d
character(1), allocatable, target :: b1,d1
is_present = .false.
call test(b, d, b1, d1, .true.)
call test(b, d, b1, d1, .false.)
call test_nil(b, b1, cond=.true.)
call test_nil(b, b1, cond=.false.)
call test2(b, a1=b1, cond=.true.)
!call test2(b1, a1=b1, cond=.false.)
!call test2(c=d, c1=d1, cond=.true.)
!call test2(c=d, c1=d1, cond=.false.)
call test2_nil(b, a1=b1, cond=.true.)
call test2_nil(b, a1=b1, cond=.false.)
!call test2_nil(cond=.true.)
!call test2_nil(cond=.false.)
b = "abc"; has_value => b
b1 = "a"; has_value1 => b1
is_present = .true.;
call test(b, d, b1, d1, .true.)
call test2(b, d, b1, d1, cond=.true.)
call test2(b, a1=b1, cond=.true.)
is_present = .false.
call test(b, d, b1, d1, .false.)
call test2(b, d, b1, d1, cond=.false.)
!call test2(b, a1=b1, cond=.false.)
!call test2(c=b, c1=b1, cond=.true.)
!call test2(c=b, c1=b1, cond=.false.)
deallocate(b,b1)
d = "12345"; has_value => d
d1 = "1"; has_value1 => d1
is_present = .false.
call test(b, d, b1, d1, .true.)
call test2(b, d, b1, d1, cond=.true.)
is_present = .true.
call test(b, d, b1, d1, .false.)
call test2(b, d, b1, d1, cond=.false.)
b = "abq"; b1 = "q"
is_present = .true.; has_value => b; has_value1 => b1
call test(b, d, b1, d1, .true.)
call test2(b, d, b1, d1, cond=.true.)
is_present = .true.; has_value => d; has_value1 => d1
call test(b, d, b1, d1, .false.)
call test2(b, d, b1, d1, cond=.false.)
is_present = .true.; has_value =>b; has_value1 => b1
call test_nil(b, a1=b1, cond=.true.)
call test2_nil(b, a1=b1, cond=.true.)
is_present = .false.
call test_nil(b, b1, .false.)
call test2_nil(b, b1, cond=.false.)
has_value => null()
has_value1 => null()
deallocate(b,d,b1,d1)
end
module m
implicit none (type,external)
logical :: is_present
integer :: has_value
contains
subroutine test(a,c, cond)
integer, value, optional :: a,c
logical, value :: cond
call sub(( cond ? a : c))
call sub_val(( cond ? a : c))
end
subroutine test_nil(a, cond)
integer, value, optional :: a
logical, value :: cond
call sub(( cond ? a : .nil.))
call sub(( .not.cond ? .nil. : a))
call sub_val(( cond ? a : .nil.))
call sub_val(( .not.cond ? .nil. : a))
end
subroutine sub(x)
integer, optional :: x
! print *, present(x)
! if (present(x)) print *, x
if (present(x) .neqv. is_present) error stop
if (present(x)) then
if (x /= has_value) error stop
end if
end
subroutine sub_val(x)
integer, optional, value :: x
! print *, present(x)
! if (present(x)) print *, x
if (present(x) .neqv. is_present) error stop
if (present(x)) then
if (x /= has_value) error stop
end if
end
end module
use m
implicit none (type,external)
is_present = .false. ! The following items fail with an 'error stop' for the present check
!call test(cond=.true.) - Wrongly claims that 'a' is present
!call test(cond=.false.) - Wrongly claims that 'c' is present
!call test_nil(cond=.true.) - Wrongly claims that 'a' is present
call test_nil(cond=.false.) ! OK
is_present = .true.; has_value = 2
call test_nil(2, cond=.true.) ! OK
call test (2, cond=.true.) ! OK
call test (c=2, cond=.false.) ! OK
is_present = .false.
call test_nil(cond=.false.) ! OK
!call test (c=4, cond=.true.) ! - Wrongly claims that 'a' is present
!call test (4, cond=.false.) ! - Wrongly claims that 'c' is present
end
