gcc: gfortran internal compiler error

[ryofurue]

brew gist-logs <formula> link OR brew config AND brew doctor output

brew gist-logs gcc says "Error: No logs."

brew config
HOMEBREW_VERSION: 3.0.5
ORIGIN: https://github.com/Homebrew/brew
HEAD: 8b677c0
Last commit: 16 hours ago
Core tap ORIGIN: https://github.com/Homebrew/homebrew-core
Core tap HEAD: 6d37897
Core tap last commit: 6 hours ago
Core tap branch: master
HOMEBREW_PREFIX: /usr/local
HOMEBREW_CASK_OPTS: []
HOMEBREW_DISPLAY: /private/tmp/com.apple.launchd.47wXew6Nqa/org.xquartz:0
HOMEBREW_MAKE_JOBS: 8
Homebrew Ruby: 2.6.3 => /usr/local/Homebrew/Library/Homebrew/vendor/portable-ruby/2.6.3_2/bin/ruby
CPU: octa-core 64-bit kabylake
Clang: 12.0 build 1200
Git: 2.30.2 => /usr/local/bin/git
Curl: 7.64.1 => /usr/bin/curl
macOS: 11.2.3-x86_64
CLT: 12.4.0.0.1.1610135815
Xcode: N/A
XQuartz: 2.7.11 => /opt/X11

brew doctor
Your system is ready to brew.

• The brew doctor above contains no "Warning" lines.

What were you trying to do (and why)?

I'm trying to compile a Fortran program.

What happened (include all command output)?

An "internal compiler error" occurs:

$ gfortran -c numeric_kinds.f90
$ gfortran -c indices.f90
$ gfortran fix-track-partials-00.f90 indices.o
f951: internal compiler error: in record_reference, at cgraphbuild.c:64
    libbacktrace could not find executable to open
Please submit a full bug report,
with preprocessed source if appropriate.
See <https://github.com/Homebrew/homebrew-core/issues> for instructions.
$

The dollar symbol above is the command prompt.

What did you expect to happen?

N/A

Step-by-step reproduction instructions (by running brew commands)

gfortran comes with Homebrew's gcc package. The step-by-step instructions are included in the "What happened" section of this report.

I don't know how to attach my Fortran source programs. So, I'll paste all of them.

$ cat numeric_kinds.f90
module numeric_kinds
  implicit NONE

  integer, parameter :: single = kind(1.0)
  integer, parameter :: double = selected_real_kind(2*precision(1.0_single))
  integer, parameter :: quadle = selected_real_kind(2*precision(1.0_double))
end module  numeric_kinds
$

---

$ cat indices.f90
module indices
  use numeric_kinds, only: double
  use iso_fortran_env, only: ERROR_UNIT

private
public:: find_idx, nearest_idx, close_enough_idx

contains

  ! Find the first index i for xx(i) such that xx(i) == x .
  ! Returns -1 if not found.
  ! (Why not return size(xx) + 1?
  !  Because it'd be confusing when size(xx) == 0.)
  function find_idx(x, xx) result(idx)
    implicit NONE
    real(double), intent(in):: x, xx(:)
    integer                 :: idx
    integer:: i
    i = 0
    do
      i = i + 1
      if (i > size(xx)) then
        i = -1
        exit
      end if
      if (xx(i) == x) exit
    end do
    idx = i
  end function find_idx


  ! find the index i for xx(i) such that xx(i) is the closest to x
  ! among xx's
  !
  ! ### xx's are assumed to be in the ascending order. ###
  !
  function nearest_idx(x, xx) result(idx)
      implicit NONE
      real(double), intent(in):: x, xx(:)
      integer                 :: idx

      real(double):: dl, last_dl
      integer     :: i, nmax

      nmax = size(xx)

      if (x < xx(1)) then
         if (xx(1) - x < (xx(2) - xx(1))/2) then
            idx = 1
            return
         else
            write(ERROR_UNIT,*) "nearest_idx: x", x, " out of range."
            error stop 1
         end if
      end if

      if (x > xx(nmax)) then
         if (x - xx(nmax) < (xx(nmax) - xx(nmax-1))/2) then
            idx = nmax
            return
         else
            write(ERROR_UNIT,*) "nearest_idx: x", x, " out of range."
            error stop 1
         end if
      end if

      last_dl = 9.99d30  !! any positive number
      i = 1
      do
         if (i > nmax) exit
         dl = xx(i) - x
         if (dl >= 0 .and. last_dl <= 0) then
            if (dl < -last_dl) then
               idx = i
            else
               idx = i-1
            end if
            exit
         end if
         last_dl = dl
         i = i + 1
      end do

      if (i > nmax) then
         write(ERROR_UNIT,*) "nearest_idx: i > nmax.  Something's wrong."
         error stop 2
      end if

   end function nearest_idx


  function close_enough_idx(x, xx, eps, verbose) result(res)
    implicit NONE
    real(double), intent(in)     :: xx(:), x, eps
    logical, intent(in), optional:: verbose
    integer                      :: res
    character(128):: mes
    res = nearest_idx(x = x, xx = xx)
    if (abs(xx(res) - x) <= eps) then
      if (present(verbose)) then
        if (verbose .eqv. .true.) then
          write(*, "(*(g0))") "x, xx(idx), idx = ", &
              x, ", ", xx(res), ", ", res
        end if
      end if
    else
      write(ERROR_UNIT, "(*(g0))") "x, xx(idx), idx = ", &
          x, ", ", xx(res), ", ", res
      error stop 3
    end if
  end function close_enough_idx


end module indices
$

---

$ cat fix-track-partials-00.f90
! Move the points in
! `track-partial-nws200-x.dat`, `track-partial-nws200-y.dat`
! onto nearest gridpoints.
!
program fix_track_partials
  use iso_fortran_env, only: IOSTAT_END, ERROR_UNIT
  use numeric_kinds, only: double

  implicit NONE

  character(*), parameter:: &
      xinf = "track-partial-nws200-x.dat", &
      yinf = "track-partial-nws200-y.dat", &
      xouf = "track-partial-nws200-x-grid.dat", &
      youf = "track-partial-nws200-y-grid.dat"
  real(double), parameter:: dundef = -0.99999999999999995d+034
  integer, parameter:: &
      lonw100 = 10000, lats100 = -4000, dlon100 = 10, dlat100 = 10
  integer, parameter:: imax = 50, jmax = 350
  integer:: i, j
  integer, dimension(*), parameter:: &
      lont100 = [((lonw100 + dlon100 * i - dlon100/2), i=1,imax)], &
      latt100 = [((lats100 + dlat100 * j - dlat100/2), j=1,jmax)]
  real(double), dimension(*), parameter:: &
      lont = [(lont100(i)/100.d0, i=1,imax)], &
      latt = [(latt100(i)/100.d0, j=1,jmax)]

  real(double), dimension(:), allocatable:: xs, ys, xs_fixed, ys_fixed

  write(*,*) "lont:", lont
  write(*,*) "latt:", latt

  call read_track(xs, ys, file = xinf)
  call move_to_nearest(xs_fixed, pnts=xs, axis=lont)
  call save_track(xs_fixed, ys, file = xouf)

  call read_track(xs, ys, file = yinf)
  call move_to_nearest(ys_fixed, pnts=ys, axis=latt)
  call save_track(xs, ys_fixed, file = youf)

contains

  ! allocate xs, ys
  subroutine read_track(xs, ys, file)
    real(double), intent(out), allocatable:: xs(:), ys(:)
    character(*), intent(in):: file
    integer:: uni, n, ios
    real(double):: x, y
    open(newunit=uni, file=file, form="FORMATTED", access="SEQUENTIAL", &
        status="OLD", position="REWIND", action="READ")
    n = 0
    do
      read(uni, *, iostat=ios) x, y
      if (ios == IOSTAT_END) exit
      if (ios /= 0) then
        write(ERROR_UNIT, "(1X,*(g0))") "read_track: iostat = ", ios
        close(uni)
        error stop 1
      end if
      n = n + 1
      call extend_arr_double(xs, n, mes="xs")
      call extend_arr_double(ys, n, mes="ys")
      xs(n) = x
      ys(n) = y
    end do
    close(uni)
    call shrink_arr_double(xs, n, mes="xs")
    call shrink_arr_double(ys, n, mes="ys")
  end subroutine read_track

  subroutine save_track(xs, ys, file)
    real(double), intent(in):: xs(:), ys(:)
    character(*), intent(in):: file
    integer:: uni, n
    open(newunit=uni, file=file, form="FORMATTED", access="SEQUENTIAL", &
        status="REPLACE", position="REWIND", action="WRITE")
    do n = 1, size(xs)
      write(uni, *) xs(n), ys(n)
    end do
    close(uni)
  end subroutine save_track

  ! For each pnts(n), find the closest point in axis(:),
  ! which is the result.
  ! Missing value will not be shifted.
  subroutine move_to_nearest(res, pnts, axis)
    use indices, only: nearest_idx
    real(double), intent(out):: res(:)
    real(double), intent(in) :: pnts(:), axis(:)
    real(double):: p
    integer:: n, idx
    do n = 1, size(pnts)
      p = pnts(n)
      if (p == dundef) then
        res(n) = dundef
      else
        idx = nearest_idx(x = pnts(n), xx = axis)
        res(n) = axis(idx)
      end if
    end do
  end subroutine move_to_nearest

  subroutine extend_arr_double(arr, idx, mes)
    real(double), allocatable, intent(inout):: arr(:)
    real(double), allocatable:: tmp(:)
    include 'extend_arr.inc'
  end subroutine extend_arr_double
  subroutine shrink_arr_double(arr, idx, mes)
    real(double), allocatable, intent(inout):: arr(:)
    real(double), allocatable:: tmp(:)
    include 'shrink_arr.inc'
  end subroutine shrink_arr_double

end program fix_track_partials
$

[Bo98]

There's a couple files missing when I tried to reproduce this locally:

fix-track-partials-00.f90:106: Error: Can't open included file 'extend_arr.inc'

Could you post them too?

The internal compiler error is very likely an upstream issue, but I'll try reproduce and confirm that first (since the GCC formula does indeed point to this issue tracker as the first port of call).

[ryofurue]

Thank you for your prompt response!

The internal compiler error is very likely an upstream issue

Right. I wondered why Homebrew wants to hear about an internal compiler error . . .

Can't open included file 'extend_arr.inc'

My bad! Here they are:

$ cat extend_arr.inc
! This is a template. Supply lines !@@@@
  ! If idx > size(arr), extend arr so that it can accomodate
  !     at least idx elements in total.
  ! If idx <= size(arr), do nothing.
!@@@@  subroutine extend_arr_T(arr, idx, mes)
!@@@@    type(T), allocatable, intent(inout):: arr(:)
!@@@@    type(T), allocatable:: tmp(:)
    integer,      intent(in)           :: idx
    character(*), intent(in), optional :: mes
    integer, parameter:: ndefault = 128
    integer:: n, nnew

    if (.not.allocated(arr)) then
      allocate(arr(ndefault))
      if (present(mes)) &
          write(*,"(*(1X,g0))") trim(mes)//": initial allocation", ndefault
    end if
    do
      n = size(arr)
      if (idx <= n) return
      allocate(tmp(n))
      tmp = arr
      deallocate(arr)
      nnew = n*2
      allocate(arr(nnew))
      arr(1:n) = tmp
      deallocate(tmp)
      if (present(mes)) &
          write(*,"(*(1X,g0))") trim(mes)//":", n, "to", nnew
    end do
!@@@@ end subroutine extend_arr_T
$

---

$ cat shrink_arr.inc
! This is a template. Supply lines !@@@@
!@@@@  subroutine shrink_arr_T(arr, idx, mes)
!@@@@    type(T), allocatable, intent(inout):: arr(:)
!@@@@    type(T), allocatable:: tmp(:)
    integer,      intent(in)           :: idx
    character(*), intent(in), optional :: mes
    integer:: n

    if (.not.allocated(arr)) then
      if (present(mes)) &
          write(*,"(*(1X,g0))") trim(mes)//": not allocated. Doing nothing."
      return
    end if
    if (idx <= 0) then
      deallocate(arr)
      allocate(arr(0))
      if (present(mes)) &
          write(*,"(*(1X,g0))") trim(mes)//": shrunk to 0 ."
      return
    end if

    n = size(arr)

    allocate(tmp(idx))
    tmp = arr(1:idx)
    deallocate(arr)
    allocate(arr(1:idx))
    arr = tmp
    deallocate(tmp)
    if (present(mes)) &
        write(*,"(*(1X,g0))") trim(mes)//": shrunk from", n, "to", idx

!@@@@ end subroutine shrunk_arr_T
$

[Bo98]

Thanks! I'm able to reproduce the issue on Ubuntu's GCC as well.

I recommend opening an upstream issue about this: https://gcc.gnu.org/bugs/. You can mention that it's reproducible with both Homebrew and Ubuntu's GCC.

---

I wondered why Homebrew wants to hear about an internal compiler error . . .

I think it's just in case we ship our own modificiations/patches, and it's those changes which have broken things. In reality, the patches we do on macOS are minimal and almost always have already been submitted upstream first. There's even times we don't have any patches at all.

Apple Silicon (arm64) is different. That GCC build is heavily modified (based on a fork) to support Apple Silicon and issues with that should definitely not go upstream. But that doesn't apply here since we're talking about x86_64.

[carlocab]

To maximise the likelihood that your bug report is addressed, you might want to reduce the error into a minimal working example.