flang-new: assumed-rank variable not implemented

[raffenet]

The MPICH library (https://github.com/pmodels/mpich) mpi_f08 Fortran binding is unable to be built with flang-new from recent main branch. This the error seen when testing compiler support for the necessary features.

ConvertVariable.cpp:1901: not yet implemented: assumed-rank variable in procedure implemented in Fortran

Is there any ETA on support for assumed-rank? I'm including the program we use to test compiler support for reproducibility.

#include <ISO_Fortran_binding.h>

int foo_c(CFI_cdesc_t * a_desc, CFI_cdesc_t * b_desc)
{
    char * a_row = (char*) a_desc->base_addr;
    if (a_desc->type != CFI_type_int) { return 1; }
    if (a_desc->rank != 2) { return 2; }
    if (a_desc->dim[1].extent != b_desc->dim[0].extent) { return 3; }
    return 0;
}

void test_assumed_rank_async_impl_c(CFI_cdesc_t * a_desc)
{
    CFI_is_contiguous(a_desc);
    return;
}

MODULE F08TS_MODULE
IMPLICIT NONE

! Test public, private, protected
REAL, PUBLIC       :: x
REAL, PRIVATE      :: y
LOGICAL, PROTECTED :: z

! Test abstract
ABSTRACT INTERFACE
    SUBROUTINE user_func(x, y)
        INTEGER  :: x(*)
        REAL     :: y
    END SUBROUTINE
END INTERFACE

! Test TS 29113 assumed type , assumed rank and bind(C)
INTERFACE
    FUNCTION FOO(A, B, C) &
        BIND(C,name="foo_c") RESULT(err)
        USE, intrinsic :: iso_c_binding, ONLY : c_int
        TYPE(*), DIMENSION(..) :: A, B, C
        INTEGER(c_int) :: err
    END FUNCTION FOO
END INTERFACE

! Test assumed-rank + asynchronous
INTERFACE TEST_ASSUMED_RANK_ASYNC
    SUBROUTINE TEST_ASSUMED_RANK_ASYNC_IMPL(BUF) &
        BIND(C,name="test_assumed_rank_async_impl_c")
        IMPLICIT NONE
        TYPE(*), DIMENSION(..), ASYNCHRONOUS :: BUF
    END SUBROUTINE TEST_ASSUMED_RANK_ASYNC_IMPL
END INTERFACE TEST_ASSUMED_RANK_ASYNC

CONTAINS

! Test TS 29113 asynchronous attribute and optional
SUBROUTINE test1(buf, count, ierr)
    INTEGER, ASYNCHRONOUS :: buf(*)
    INTEGER               :: count
    INTEGER, OPTIONAL     :: ierr
END SUBROUTINE

! Test procedure type and non-bind(c) x in C_FUNCLOC(x)
SUBROUTINE test2(func)
    USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_FUNLOC, C_FUNPTR
    PROCEDURE(user_func)  :: func
    TYPE(C_FUNPTR) :: errhandler_fn
    errhandler_fn = C_FUNLOC(func)
END SUBROUTINE

! Test intrinsic storage_size
SUBROUTINE test3(x, size)
    CHARACTER, DIMENSION(..) :: x
    INTEGER, INTENT(OUT) :: size
    size = storage_size(x)/8
END SUBROUTINE test3

END MODULE

[jeanPerier]

Hi @raffenet, the assumed-rank implementation is near completion. The code that you gave compile under the flang developer option "-mmlir -allow-assumed-rank".

Before I turn assumed-rank on without this switch, I want to:

• merge support for some corner cases: https://github.com/llvm/llvm-project/pull/96111, https://github.com/llvm/llvm-project/pull/96106, https://github.com/llvm/llvm-project/pull/96082, https://github.com/llvm/llvm-project/pull/96080
• implement the support of RANK(*) case with polymorphic selectors in SELECT RANK (https://github.com/llvm/llvm-project/blob/61e62ce2ebde23937af3e4ca2d84195bb00dbe05/flang/lib/Lower/Bridge.cpp#L3324).
• run a few end to end validation tests.

[raffenet]

Thanks for the reply! I can confirm that our binding does compile with the -mmlir -allow-assumed-rank flags. FWIW, I see these warnings in the build related to using c_loc on some function arguments. For example:

SUBROUTINE MPI_Comm_spawn_f08(command, argv, maxprocs, info, root, comm, intercomm, &
                              array_of_errcodes, ierror)
    USE, intrinsic :: iso_c_binding, ONLY : c_char, c_ptr, c_loc, c_associated, c_int
    USE :: mpi_f08_types, ONLY : MPI_Info, MPI_Comm
    USE :: mpi_f08_link_constants, ONLY : MPI_ARGV_NULL, MPIR_F08_get_MPI_ARGV_NULL_c, &
        MPI_ERRCODES_IGNORE, MPIR_F08_get_MPI_ERRCODES_IGNORE_c
    USE :: mpi_c_interface_types, ONLY : c_Info, c_Comm
    USE :: mpi_c_interface, ONLY : MPIR_Comm_spawn_c
    USE :: mpi_c_interface_glue, ONLY : MPIR_Fortran_string_f2c

    IMPLICIT NONE

    CHARACTER(len=*), INTENT(in) :: command
    CHARACTER(len=*), INTENT(in), TARGET :: argv(*)
    INTEGER, INTENT(in) :: maxprocs
    TYPE(MPI_Info), INTENT(in) :: info
    INTEGER, INTENT(in) :: root
    TYPE(MPI_Comm), INTENT(in) :: comm
    TYPE(MPI_Comm), INTENT(out) :: intercomm
    INTEGER, TARGET :: array_of_errcodes(*)
    INTEGER, OPTIONAL, INTENT(out) :: ierror

    character(kind=c_char) :: command_c(len_trim(command) + 1)
    TYPE(c_ptr) :: argv_cptr
    INTEGER(c_int) :: maxprocs_c
    INTEGER(c_Info) :: info_c
    INTEGER(c_int) :: root_c
    INTEGER(c_Comm) :: comm_c
    INTEGER(c_Comm) :: intercomm_c
    TYPE(c_ptr) :: array_of_errcodes_cptr
    LOGICAL :: has_errcodes_ignore = .false.
    INTEGER(c_int), TARGET :: array_of_errcodes_c(maxprocs)
    INTEGER(c_int) :: argv_len
    INTEGER(c_int) :: ierror_c

    call MPIR_Fortran_string_f2c(command, command_c)
    argv_cptr = c_loc(argv)
    IF (c_associated(argv_cptr, c_loc(MPI_ARGV_NULL))) THEN
        argv_cptr = MPIR_F08_get_MPI_ARGV_NULL_c()
    END IF
    array_of_errcodes_cptr = c_loc(array_of_errcodes)
    IF (c_associated(array_of_errcodes_cptr, c_loc(MPI_ERRCODES_IGNORE))) THEN
        array_of_errcodes_cptr = MPIR_F08_get_MPI_ERRCODES_IGNORE_c()
        has_errcodes_ignore = .true.
    END IF
    argv_len = len(argv)

    ierror_c = MPIR_Comm_spawn_c(command_c, argv_cptr, maxprocs, info%MPI_VAL, root, comm%MPI_VAL, &
                                 intercomm%MPI_VAL, array_of_errcodes_cptr, argv_len)

    IF (present(ierror)) ierror = ierror_c
END SUBROUTINE MPI_Comm_spawn_f08

./src/binding/fortran/use_mpi_f08/wrappers_f/f08ts.f90:13357:23: warning: C_LOC() argument has non-interoperable intrinsic type, kind, or length
      argv_cptr = c_loc(argv)
                        ^^^^