Modern Fortran Explained - 2018 §21.5 C descriptors

暑いので適当ｗ interface に type(*) :: x(..) を使ったのが新奇。　

attribute がうまく取れていないのが謎。

実行結果

gfortran-9/gcc-9

hp8@HP8:~/f2018$ gfortran-9 c_mfe215b.c mfe215b.f90
hp8@HP8:~/f2018$ ./a.out
 -mtune=generic -march=x86-64

other
rank=0
lowerbound0 extent0 spacing0
CFI_type_double

other
rank=2
lowerbound0 extent10 spacing4
CFI_type_float

other
rank=0
lowerbound0 extent10 spacing4
CFI_type_double

other
rank=1
lowerbound0 extent100 spacing4
CFI_type_float

other
rank=0
lowerbound0 extent100 spacing4
CFI_type_float

STOP normal termination

ifort/icc

hp8@HP8:~/f2018$ vi mfe215b.f90
hp8@HP8:~/f2018$ icc -c   c_mfe215b.c
hp8@HP8:~/f2018$ ifort   c_mfe215b.o mfe215b.f90
hp8@HP8:~/f2018$ ./a.out


other
rank=0
lowerbound13 extent1886220131 spacing1
CFI_type_double

other
rank=2
lowerbound0 extent10 spacing4
CFI_type_float

other
rank=0
lowerbound469778721 extent-604196248 spacing26577600
CFI_type_double

other
rank=1
lowerbound0 extent100 spacing4
CFI_type_float

other
rank=0
lowerbound0 extent0 spacing0
CFI_type_float

normal termination

ソース・プログラム

fortran

program test
    use, intrinsic :: iso_fortran_env
    use, intrinsic :: iso_c_binding
    implicit none
    interface
        subroutine cfi_members(string) bind(c, name = 'cfi_members')
            use, intrinsic :: iso_c_binding
            type(*) :: string(..)
        end subroutine cfi_members
    end interface

    real(kind=kind(1.0d0)), target :: a
    real :: b(10, 10)
    real(kind=kind(1.0d0)), pointer :: p
    real, allocatable :: x(:), y
    integer :: i, j

    print *, compiler_options()
    print *

    a = 1.0
    call cfi_members(a)

    forall(i=1:10, j=1:10) b(i, j) = i + j
    call cfi_members(b)

    p => a
    call cfi_members(p)

    x = [(i, i = 1, 100)]
    call cfi_members(x)

    call cfi_members(y)

    stop 'normal termination'
end program test

C

#include <stdio.h>
#include "ISO_Fortran_binding.h"

void cfi_members(CFI_cdesc_t *string) {
    CFI_attribute_t attrib = string->attribute;
    if (attrib == CFI_attribute_allocatable) {printf("allocatable\n");};
    if (attrib == CFI_attribute_pointer    ) {printf("pointer\n");};
    if (attrib == CFI_attribute_other      ) {printf("other\n");};

    CFI_rank_t nrank = string->rank;
    printf("rank=%d\n", (int)nrank);

    CFI_dim_t *dim = string->dim;
    CFI_index_t lowerbound = dim->lower_bound;
    CFI_index_t extent     = dim->extent;
    CFI_index_t sm         = dim->sm;
    printf("lowerbound%d extent%d spacing%d\n", (int) lowerbound, (int) extent, (int) sm);

    CFI_type_t ctype = string->type;
    switch (ctype) {
        case CFI_type_int:
//        case CFI_type_int32_t:
            printf("CFI_type_int\n");
            break;
        case CFI_type_Bool:
            printf("CFI_type_Bool\n");
            break;
        case CFI_type_float:
            printf("CFI_type_float\n");
            break;
        case CFI_type_double:
//        case CFI_type_long_double:
            printf("CFI_type_double\n");
            break;
        case CFI_type_cptr:
            printf("CFI_type_cptr\n");
            break;
//        case CFI_type_int64_t:
//        case CFI_type_long:
//        case CFI_type_long_long:
//        case CFI_type_size_t:
//        case CFI_type_intmax_t:
//        case CFI_type_intptr_t:
//          case CFI_type_ptrdiff_t:

        case CFI_type_short:
//        case CFI_type_int16_t:
            printf("CFI_type_short\n");
            break;
        case CFI_type_int8_t:
//        case CFI_type_signed_char:
            printf("CFI_type_signed_char\n");
            break;
// undefined        case CFI_type_least8_t:
//        case CFI_type_least16_t:
//        case CFI_type_least32_t:
//        case CFI_type_least64_t:
//        case CFI_type_fast8_t:
//        case CFI_type_fast16_t:
//        case CFI_type_fast32_t:
//        case CFI_type_fast64_t:
        case CFI_type_struct:
            printf("CFI_type_struct\n");
            break;
        case CFI_type_other:
            printf("CFI_type_other\n");
            break;
        case CFI_type_float_Complex:
            printf("CFI_type_float_Complex\n");
            break;
        case CFI_type_double_Complex:
//        case CFI_type_long_double_Complex:
            printf("CFI_type_double_Complex\n");
            break;
        case CFI_type_char:
            printf("CFI_type_char\n");
            break;
        default:
            printf("case default\n");
    }



    printf("\n");
}