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

            Bug ID: 125528
           Summary: ICE or wrong-code for ASSOCIATE selector that is a
                    type-bound user-defined operator
           Product: gcc
           Version: 16.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: jvdelisle at gcc dot gnu.org
  Target Milestone: ---

gfortran fails to compile ASSOCIATE constructs whose
  selector is a type-bound user-defined operator (UDO)
  expression.  Three related cases are affected:

  1. A direct type-bound UDO as the selector
  (associate (g => .grad. s)).
  2. An inherited UDO defined on a parent type
  (associate (q => .sq. s)).
  3. Nested UDO expressions
  (associate (r => .div. (.grad. s))).

  In case 1 gfortran produces an ICE ("Syntax error in
  expression") inside the ASSOCIATE body because the
  associate variable is left without a type.  Cases 2 and 3
  produce similar failures.  Intel Fortran and NAG Fortran
  accept all three cases.

  module m
    implicit none
    type :: scalar_t
      real :: val
    contains
      generic :: operator(.grad.) => do_grad
      procedure, private :: do_grad
      generic :: operator(.sq.)   => do_sq
      procedure, private :: do_sq
      generic :: get => get_val
      procedure :: get_val
    end type

    type, extends(scalar_t) :: vector_t
    contains
      generic :: operator(.div.) => do_div
      procedure, private :: do_div
    end type
  contains
    pure function do_grad (self) result (r)
      class(scalar_t), intent(in) :: self
      type(vector_t) :: r
      r%val = self%val * 2.0
    end function
    pure function do_sq (self) result (r)
      class(scalar_t), intent(in) :: self
      type(scalar_t) :: r
      r%val = self%val * self%val
    end function
    pure function do_div (self) result (r)
      class(vector_t), intent(in) :: self
      type(scalar_t) :: r
      r%val = self%val / 2.0
    end function
    pure function get_val (self) result (r)
      class(scalar_t), intent(in) :: self
      real :: r
      r = self%val
    end function
  end module m

  program p
    use m
    implicit none
    type(scalar_t) :: s
    s%val = 3.0
    associate (g => .grad. s)        ! case 1
      if (abs (g%val - 6.0) > 1.0e-6) stop 1
    end associate
    associate (q => .sq. s)          ! case 2
      if (abs (q%val - 9.0) > 1.0e-6) stop 2
    end associate
    associate (r => .div. (.grad. s)) ! case 3
      if (abs (r%val - 3.0) > 1.0e-6) stop 3
    end associate
  end program p

  $ gfortran associate.f90

  gfortran ICEs or rejects the code.  The program should
  compile and run cleanly.

Reply via email to