Re: [patch, fortran] Fix PR 85781, ICE on valid

[Tobias Burnus]

Hi Thomas,

On 1/19/20 7:21 PM, Thomas König wrote:
the attached patch fixes an ICE which could occur for empty
substrings (see test case).

I think one should rather fix the following issue. – While on x86-64 it 
does not seem to cause problems, it might for other platforms. 
Additionally, it is a missed optimization to use "A123" instead of "66" 
in the call.

Namely, gfortran generates a different code when using kind=c_type 
instead of kind=1 – although the kind value is the same! (Without 
BIND(C) or without VALUE, the generated code is the same.) The dump is:

two (character(kind=1)[1:1] x) vs.  three (character(kind=1) x)

Expected is the latter. See attached test case.

Tobias

! { dg-additional-arguments "-fdump-tree-original" }

subroutine k1a(x) bind(C)
  character(kind=1), value :: x
  !print *, x
  if (x /= 'A') stop 1
end

subroutine k1b(x) bind(C)
  character(kind=1), value :: x
  !print *, x
  if (x /= 'B') stop 2
end

subroutine cc1(x) bind(C)
  use iso_c_binding, only: c_char
  character(kind=c_char), value :: x
  !print *, x
  if (x /= 'C') stop 3
end

subroutine cc2(x) bind(C)
  use iso_c_binding, only: c_char
  character(kind=c_char), value :: x
  !print *, x
  if (x /= 'D') stop 4
end

subroutine print_kind()
  use iso_c_binding, only: c_char
  !print *, c_char
  if (c_char /= 1) stop 5
end

program main
  implicit none
  external print_kind
  interface
    subroutine k1a(x) bind(C)
      character(kind=1), value :: x
    end
    subroutine k1b(x) bind(C)
      use iso_c_binding, only: c_char
      character(kind=c_char), value :: x
    end
    subroutine cc1(x) bind(C)
      character(kind=1), value :: x
    end
    subroutine cc2(x) bind(C)
      use iso_c_binding, only: c_char
      character(kind=c_char), value :: x
    end
  end interface

  call print_kind()
  call k1a('A')
  call k1b('B')
  call cc1('C')
  call cc2('D')

  call k1a('A123')
  call k1b('B123')
  call cc1('C123')
  call cc2('D123')
end
! { dg-final { scan-tree-dump-times "character\\(kind=1\\) x" 4 "original" } }
! { dg-final { scan-tree-dump-not "character\\(kind=1\\)*1.*x" "original" } }

! { dg-final { scan-tree-dump-times "k1a \\(65\\);" 2 "original" } }
! { dg-final { scan-tree-dump-times "k1b \\(66\\);" 2 "original" } }
! { dg-final { scan-tree-dump-times "cc1 \\(67\\);" 2 "original" } }
! { dg-final { scan-tree-dump-times "cc2 \\(68\\);" 2 "original" } }
! { dg-final { scan-tree-dump-not "\\(\"" "original" } }