https://gcc.gnu.org/bugzilla/show_bug.cgi?id=118080

            Bug ID: 118080
           Summary: OPTIONAL, VALUE mishandled: type(c_ptr) – argument
                    missing, ICE with derived type
           Product: gcc
           Version: 15.0
            Status: UNCONFIRMED
          Keywords: ice-on-valid-code, wrong-code
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: burnus at gcc dot gnu.org
  Target Milestone: ---

ONE.f90 is an interesting issue, for:
   call f(a)
   call f()
   call f(a)
the hidden second is-present argument is absent for the first call ('f(a)') but
present in the others ('f(NULL, false)', 'f(a, true)' - or rather: 'f(0,0)' and
'f(a,1)').

Digging, the reason is that for the first 'call f(a)', the dummy argument has:
  fsym->ts.type == BT_DERIVED with fsym->ts.u.derived->ts.f90_type == BT_VOID.

But when doing the same for the next 'call f(a)', it has:
  BT_INTEGER' of a kind = c_intptr_t.


It is unsurprising that this fails because trans-expr.cc has:

static void
conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
                  vec<tree, va_gc> *& optionalargs)
{         
...
  if (fsym->attr.optional
      && fsym->ts.type != BT_CLASS
      && fsym->ts.type != BT_DERIVED)
    {
...
    }
}



Ignoring the question why fsym changes its type, the question is:
  Why is BT_DERIVED not handled?

TYPE(T) with VALUE and OPTIONAL seems to be perfectly valid in Fortran
2003/2008/2018/2023.


Hence, I wrote TWO.f90 - result:

  internal compiler error: in fold_convert_loc, at fold-const.cc:2779


-----------------<ONE.f90>--------------------------
! { dg-do additional-options "-fdump-tree-original" }
module m
  use iso_c_binding
  implicit none(type,external)
  logical is_present
contains
  subroutine f(x)
    ! void f (void * x, logical(kind=1) .x)  - 2nd arg = is-present flag
    type(c_ptr), optional, value :: x
    if (present(x) .neqv. is_present) stop 1
    if (present(x)) then
      block
        integer, pointer :: ptr
        call c_f_pointer(x,ptr)
        if (ptr /= 55) stop 2
      end block
    endif
  end
end

use m
implicit none(type,external)
  type(c_ptr) :: a
  integer, target :: x
  a = c_loc(x)
  x = 55

  is_present = .true.
  call f(a) ! Wrong -> f (a); - lacks second argument

  is_present = .false.
  call f()  ! OK -> f (0B, 0)

  ! Trying again after the absent call:
  is_present = .true.
  call f(a) ! Now OK -> f (a, 1); - lacks second argument
end

! { dg-final { scan-tree-dump "f \\(a, 1\\);" 2 "original" } }
! { dg-final { scan-tree-dump "f \\(0B, 0\\);" 1 "original" } }


-----------------<TWO.f90>--------------------------
module m
  implicit none(type,external)
  logical is_present
  type t
  end type t
contains
  subroutine g(x)
    type(t), value, optional :: x
    if (is_present .neqv. present(x)) stop 99
  end
end

subroutine one
  use m
  implicit none(type,external)
  type(t) :: a
  integer, target :: x
  x = 55

  is_present = .true.
  call g(a)

  is_present = .false.
  call g()

  is_present = .true.
  call g(a)
end

call one
end

Reply via email to