[Patch, fortran] PR96320 - gfortran 8-10 shape mismatch in assumed-length dummy argument character array

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 804 bytes --]

Hi All,

This is my first foray into gfortran for quite a little while so I am going
cautiously on this 'obvious' patch. The comment in the patch and the
ChangLog are clear enough that no further explanation is needed.

Regtests on FC31.x86_64 - OK for trunk?

I am a bit reluctant to get into backporting just yet because I am still
groping my way round git. However, I will do it when I feel a bit braver!

Regards

Paul

2020-07-31  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/96320
* interface.c (gfc_check_dummy_characteristics): If a module
procedure arrives with assumed shape in the interface and
deferred shape in the procedure itself, update the latter and
copy the lower bounds.

2020-07-31  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/96320
* gfortran.dg/module_procedure_4.f90 : New test.

[-- Attachment #2: submit.diff --]
[-- Type: application/x-patch, Size: 1865 bytes --]

[-- Attachment #3: module_procedure_4.f90 --]
[-- Type: text/x-fortran, Size: 1460 bytes --]

! { dg-do run }
!
! Test the fix for PR96320 in which the assumed shape of 'arg' in the
! interface for 'bar' was mirrored by the 'arg' in the module procedure
! incorrectly have deferred shape.
!
! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
!
module foobar
  type foo
  contains
    procedure, nopass :: bar1
    procedure, nopass :: bar2
    procedure, nopass :: bar3
  end type

  interface

    module subroutine bar1(arg)
      character(len=*) arg(:)
    end subroutine

    module subroutine bar2(arg)
      character(len=*) arg(3:)
    end subroutine

    module subroutine bar3(arg)
      character(len=*) arg(2)
    end subroutine

  end interface
contains

  module procedure bar1
    if (lbound(arg, 1) .ne. 1) stop 1
    if (arg(3) .ne. 'hijk') stop 2
  end procedure

! Make sure that the lower bound of an assumed shape array dummy,
! if defined, is passed to the module procedure.

  module procedure bar2
    if (lbound(arg, 1) .ne. 3) stop 3
    if (arg(3) .ne. 'abcd') stop 4
  end procedure

! This makes sure that an dummy with explicit shape has the upper
! bound correctly set in the module procedure.

  module procedure bar3
    if (lbound(arg, 1) .ne. 1) stop 5
    if (arg(3) .ne. 'hijk') stop 6       ! { dg-warning "is out of bounds" }
  end procedure

end module

  use foobar
  character(4) :: list(3) = ['abcd', 'efgh' , 'hijk']
  type(foo) :: f
  call f%bar1(list)
  call f%bar2(list)
  call f%bar3(list)
end