diff mbox series

Fortran: Fix Bind(C) Array-Descriptor Conversion (Move to Front-End Code)

Message ID 8b78cd9e-da1e-ce8f-164c-ca4a3b4a7eb4@codesourcery.com
State New
Headers show
Series Fortran: Fix Bind(C) Array-Descriptor Conversion (Move to Front-End Code) | expand

Commit Message

Tobias Burnus Sept. 6, 2021, 10:52 a.m. UTC 
Hi all,

gfortran's internal array descriptor (xgfc descriptor) and
the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
procedure the gfc descriptor has to be converted to cfi – and when a
BIND(C) procedure is implemented in Fortran, the argument has to be
converted back from CFI to gfc.

The current implementation handles part in the FE and part in libgfortran,
but there were several issues, e.g. PR101635 failed due to alias issues,
debugging wasn't working well, uninitialized memory was used in some cases
etc.

This patch now moves descriptor conversion handling to the FE – which also
can make use of compile-time knowledge, useful both for diagnostic and to
optimize the code.

Additionally:
- Some cases where TS29113 mandates that the array descriptor should be
   used now use the array descriptor, in particular character scalars with
   'len=*' and allocatable/pointer scalars.
- While debugging the alias issue, I simplified 'select rank'. While some
   special case is needed for assumed-shape arrays, those cannot appear when
   the argument has the pointer or allocatable attribute. That's not only a
   missed optimization, pointer/allocatable arrays can also be NULL - such
   that accessing desc->dim.ubound[rank-1] can be uninitialized memory ...

OK?  Comments? Suggestions?

  * * *

For some more dumps, see the discussion about the alias issue at:
https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
("[RFH] ME optimizes variable assignment away / Fortran bind(C) descriptor conversion")
plus the original emails:
- https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
- and (correct dump) https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html

Debugging - not ideal but not too bad either. For
   subroutine f(x) bind(C)
     integer :: x(:)
with an uninitialized size-4 array as argument:

m::f (_x=...) at foo4.f90:3
3       subroutine f(x) bind(C)
(gdb) p x
Cannot access memory at address 0x38
(gdb) p _x
$6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank = 1 '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound = 0, extent = 5, sm = 4 )) )
(gdb) s
5         x(1) = 5
(gdb) p x
$7 = (0, 0, 0, -670762413, 0)


Tobias

PS: This patch fixes but not necessarily fully the following PRs:
PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*) as actual argument to assumed-rank
PR fortran/92189 - Fortran-written bind(C) function with allocatable argument does not update C descriptor on exit
PR fortran/92621 - Problems with memory handling with allocatable intent(out) arrays with bind(c)
PR fortran/101308 - Bind(C): gfortran does not create C descriptors for scalar pointer/allocatable arguments
PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
PR fortran/92482 - BIND(C) with array-descriptor mishandled for type character
and possibly some more.

PPS: I should add some additional testcases – I try to do this as Part 2 of this patch.

PPPS: Once the patch is in, some audit needs to be done which parts of those PRs remain
as follow-up work. I think some still existing issues are covered by José's pending
patches + for those which are now fixed, the testcase might still be added.

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

Comments

Tobias Burnus Sept. 10, 2021, 6:48 p.m. UTC | #1 
Early PING for that patch.

On 06.09.21 12:52, Tobias Burnus wrote:
> Hi all,
>
> gfortran's internal array descriptor (xgfc descriptor) and
> the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
> of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
> procedure the gfc descriptor has to be converted to cfi – and when a
> BIND(C) procedure is implemented in Fortran, the argument has to be
> converted back from CFI to gfc.
>
> The current implementation handles part in the FE and part in
> libgfortran,
> but there were several issues, e.g. PR101635 failed due to alias issues,
> debugging wasn't working well, uninitialized memory was used in some
> cases
> etc.
>
> This patch now moves descriptor conversion handling to the FE – which
> also
> can make use of compile-time knowledge, useful both for diagnostic and to
> optimize the code.
>
> Additionally:
> - Some cases where TS29113 mandates that the array descriptor should be
>   used now use the array descriptor, in particular character scalars with
>   'len=*' and allocatable/pointer scalars.
> - While debugging the alias issue, I simplified 'select rank'. While some
>   special case is needed for assumed-shape arrays, those cannot appear
> when
>   the argument has the pointer or allocatable attribute. That's not
> only a
>   missed optimization, pointer/allocatable arrays can also be NULL - such
>   that accessing desc->dim.ubound[rank-1] can be uninitialized memory ...
>
> OK?  Comments? Suggestions?
>
>  * * *
>
> For some more dumps, see the discussion about the alias issue at:
> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
> ("[RFH] ME optimizes variable assignment away / Fortran bind(C)
> descriptor conversion")
> plus the original emails:
> - https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
> - and (correct dump)
> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html
>
> Debugging - not ideal but not too bad either. For
>   subroutine f(x) bind(C)
>     integer :: x(:)
> with an uninitialized size-4 array as argument:
>
> m::f (_x=...) at foo4.f90:3
> 3       subroutine f(x) bind(C)
> (gdb) p x
> Cannot access memory at address 0x38
> (gdb) p _x
> $6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank = 1
> '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound = 0,
> extent = 5, sm = 4 )) )
> (gdb) s
> 5         x(1) = 5
> (gdb) p x
> $7 = (0, 0, 0, -670762413, 0)
>
>
> Tobias
>
> PS: This patch fixes but not necessarily fully the following PRs:
> PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*) as
> actual argument to assumed-rank
> PR fortran/92189 - Fortran-written bind(C) function with allocatable
> argument does not update C descriptor on exit
> PR fortran/92621 - Problems with memory handling with allocatable
> intent(out) arrays with bind(c)
> PR fortran/101308 - Bind(C): gfortran does not create C descriptors
> for scalar pointer/allocatable arguments
> PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling
> issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
> PR fortran/92482 - BIND(C) with array-descriptor mishandled for type
> character
> and possibly some more.
>
> PPS: I should add some additional testcases – I try to do this as Part
> 2 of this patch.
>
> PPPS: Once the patch is in, some audit needs to be done which parts of
> those PRs remain
> as follow-up work. I think some still existing issues are covered by
> José's pending
> patches + for those which are now fixed, the testcase might still be
> added.
>
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Tobias Burnus Oct. 9, 2021, 9:55 p.m. UTC | #2 
Re-sent with gzipped attachment as gcc-patches@ did reject it as being too large.
Alternatively, you can find it at
https://gcc.gnu.org/pipermail/fortran/attachments/20211009/dc26f92d/attachment-0001.bin
as fortran@ contrary to gcc-patches@ did accept the patch ...

Tobias

On 09.10.21 23:48, Tobias Burnus wrote:
> Hi all,
>
> attached is the updated version. Changes:
> * Handle noncontiguous arrays – with BIND(C), (g)Fortran needs to make it
>   contiguous in the caller but also handle noncontiguous in the callee.
> * Fixes/handle 'character(len=*)' with BIND(C); those always use an
>   array descriptor - also with explicit-size and assumed-size arrays
> * Fixed a bunch of bugs, found when writing extensive testcases.
> * Fixed type(*) handling - those now pass properly type and elem_len
>   on when calling a new function (bind(C) or not).
>
> Besides adding the type itself (which is rather straight forward),
> this patch only had minor modifications – and then the two big
> conversion functions.
>
> While it looks intimidating, it should be comparably simple to
> review as everything is on one place and hopefully sufficiently
> well documented.
>
> OK – for mainline?  Other comments? More PRs which are fixed?
> Issues not yet fixed (which are inside the scope of this patch)?
>
> (If this patch is too long, I also have a nine-day old pending patch
> at https://gcc.gnu.org/pipermail/gcc-patches/2021-October/580624.html )
>
> Tobias
>
> PS: The following still applies.
>
> On 06.09.21 12:52, Tobias Burnus wrote:
>> gfortran's internal array descriptor (xgfc descriptor) and
>> the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
>> of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
>> procedure the gfc descriptor has to be converted to cfi – and when a
>> BIND(C) procedure is implemented in Fortran, the argument has to be
>> converted back from CFI to gfc.
>>
>> The current implementation handles part in the FE and part in
>> libgfortran,
>> but there were several issues, e.g. PR101635 failed due to alias issues,
>> debugging wasn't working well, uninitialized memory was used in some
>> cases
>> etc.
>>
>> This patch now moves descriptor conversion handling to the FE – which
>> also
>> can make use of compile-time knowledge, useful both for diagnostic
>> and to
>> optimize the code.
>>
>> Additionally:
>> - Some cases where TS29113 mandates that the array descriptor should be
>>   used now use the array descriptor, in particular character scalars
>> with
>>   'len=*' and allocatable/pointer scalars.
>> - While debugging the alias issue, I simplified 'select rank'. While
>> some
>>   special case is needed for assumed-shape arrays, those cannot
>> appear when
>>   the argument has the pointer or allocatable attribute. That's not
>> only a
>>   missed optimization, pointer/allocatable arrays can also be NULL -
>> such
>>   that accessing desc->dim.ubound[rank-1] can be uninitialized memory
>> ...
>>
>> OK?  Comments? Suggestions?
>>
>>  * * *
>>
>> For some more dumps, see the discussion about the alias issue at:
>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
>> ("[RFH] ME optimizes variable assignment away / Fortran bind(C)
>> descriptor conversion")
>> plus the original emails:
>> - https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
>> - and (correct dump)
>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html
>>
>> Debugging - not ideal but not too bad either. For
>>   subroutine f(x) bind(C)
>>     integer :: x(:)
>> with an uninitialized size-4 array as argument:
>>
>> m::f (_x=...) at foo4.f90:3
>> 3       subroutine f(x) bind(C)
>> (gdb) p x
>> Cannot access memory at address 0x38
>> (gdb) p _x
>> $6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank =
>> 1 '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound =
>> 0, extent = 5, sm = 4 )) )
>> (gdb) s
>> 5         x(1) = 5
>> (gdb) p x
>> $7 = (0, 0, 0, -670762413, 0)
>>
>>
>> Tobias
>>
>> PS: This patch fixes but not necessarily fully the following PRs:
>> PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*)
>> as actual argument to assumed-rank
>> PR fortran/92189 - Fortran-written bind(C) function with allocatable
>> argument does not update C descriptor on exit
>> PR fortran/92621 - Problems with memory handling with allocatable
>> intent(out) arrays with bind(c)
>> PR fortran/101308 - Bind(C): gfortran does not create C descriptors
>> for scalar pointer/allocatable arguments
>> PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling
>> issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
>> PR fortran/92482 - BIND(C) with array-descriptor mishandled for type
>> character
>> and possibly some more.
>>
>> PPS: I should add some additional testcases – I try to do this as
>> Part 2 of this patch.
>>
>> PPPS: Once the patch is in, some audit needs to be done which parts
>> of those PRs remain
>> as follow-up work. I think some still existing issues are covered by
>> José's pending
>> patches + for those which are now fixed, the testcase might still be
>> added.
>>
>> -----------------
>> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße
>> 201, 80634 München; Gesellschaft mit beschränkter Haftung;
>> Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der
>> Gesellschaft: München; Registergericht München, HRB 106955
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Tobias Burnus Oct. 13, 2021, 4:01 p.m. UTC | #3 
Dear all,

a minor update [→ v3].

I searched for XFAIL in Sandra's c-interop/ and found
two remaining true** xfails, now fixed:

- gfortran.dg/c-interop/typecodes-scalar-basic.f90
   The conversion of scalars of type(c_ptr) was mishandled;
   fixed now; the fix did run into issues converting a string_cst,
   which has also been fixed.

- gfortran.dg/c-interop/fc-descriptor-7.f90
   this one uses TRANSPOSE which did not work [now mostly* does]
   → PR fortran/101309 now also fixed.

I forgot what the exact issue for the latter was. However, when
looking at the testcase and extending it, I did run into the
following issue - and at the end the testcase does now pass.
The issue I had was that when a contiguous check was requested
(i.e. only copy in when needed) it failed to work, when
parmse->expr was (a pointer to) a descriptor. I fixed that and
now most* things work.

OK for mainline? Comments? Suggestions? More PRs which fixes
this patch? Regressions? Test results?

Tobias

PS: I intent to commit this patch to the OG11 (devel/omp/gcc-11)
branch, in case someone wants to test it there.

PPS: Nice to have an extensive testcase suite - kudos to Sandra
in this case. I am sure Gerald will find more issues and once
it is in, I think I/we have to check some PRs + José's patches
whether for additional testcases + follow-up fixes.

(*) I write most as passing a (potentially) noncontiguous
assumed-rank array to a CONTIGUOUS assumed-rank array causes
an ICE as the scalarizer does not handle dynamic ranks alias
expr->rank == -1 / ss->dimen = -1.
I decided that that's a separate issue and filled:
https://gcc.gnu.org/PR102729
BTW, my impression is that fixing that PR might fix will solve
the trans*.c part of https://gcc.gnu.org/PR102641 - but I have
not investigated.

(**) There are still some 'xfail' in comments (outside dg-*)
whose tests now pass. And those where for two bugs in the same
statement, only one is reported - and the other only after fixing
the first one, which is fine.

On 09.10.21 23:48, Tobias Burnus wrote:
> Hi all,
>
> attached is the updated version. Changes:
> * Handle noncontiguous arrays – with BIND(C), (g)Fortran needs to make it
>   contiguous in the caller but also handle noncontiguous in the callee.
> * Fixes/handle 'character(len=*)' with BIND(C); those always use an
>   array descriptor - also with explicit-size and assumed-size arrays
> * Fixed a bunch of bugs, found when writing extensive testcases.
> * Fixed type(*) handling - those now pass properly type and elem_len
>   on when calling a new function (bind(C) or not).
>
> Besides adding the type itself (which is rather straight forward),
> this patch only had minor modifications – and then the two big
> conversion functions.
>
> While it looks intimidating, it should be comparably simple to
> review as everything is on one place and hopefully sufficiently
> well documented.
>
> OK – for mainline?  Other comments? More PRs which are fixed?
> Issues not yet fixed (which are inside the scope of this patch)?
>
> (If this patch is too long, I also have a nine-day old pending patch
> at https://gcc.gnu.org/pipermail/gcc-patches/2021-October/580624.html )
>
> Tobias
>
> PS: The following still applies.
>
> On 06.09.21 12:52, Tobias Burnus wrote:
>> gfortran's internal array descriptor (xgfc descriptor) and
>> the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
>> of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
>> procedure the gfc descriptor has to be converted to cfi – and when a
>> BIND(C) procedure is implemented in Fortran, the argument has to be
>> converted back from CFI to gfc.
>>
>> The current implementation handles part in the FE and part in
>> libgfortran,
>> but there were several issues, e.g. PR101635 failed due to alias issues,
>> debugging wasn't working well, uninitialized memory was used in some
>> cases
>> etc.
>>
>> This patch now moves descriptor conversion handling to the FE – which
>> also
>> can make use of compile-time knowledge, useful both for diagnostic
>> and to
>> optimize the code.
>>
>> Additionally:
>> - Some cases where TS29113 mandates that the array descriptor should be
>>   used now use the array descriptor, in particular character scalars
>> with
>>   'len=*' and allocatable/pointer scalars.
>> - While debugging the alias issue, I simplified 'select rank'. While
>> some
>>   special case is needed for assumed-shape arrays, those cannot
>> appear when
>>   the argument has the pointer or allocatable attribute. That's not
>> only a
>>   missed optimization, pointer/allocatable arrays can also be NULL -
>> such
>>   that accessing desc->dim.ubound[rank-1] can be uninitialized memory
>> ...
>>
>> OK?  Comments? Suggestions?
>>
>>  * * *
>>
>> For some more dumps, see the discussion about the alias issue at:
>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
>> ("[RFH] ME optimizes variable assignment away / Fortran bind(C)
>> descriptor conversion")
>> plus the original emails:
>> - https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
>> - and (correct dump)
>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html
>>
>> Debugging - not ideal but not too bad either. For
>>   subroutine f(x) bind(C)
>>     integer :: x(:)
>> with an uninitialized size-4 array as argument:
>>
>> m::f (_x=...) at foo4.f90:3
>> 3       subroutine f(x) bind(C)
>> (gdb) p x
>> Cannot access memory at address 0x38
>> (gdb) p _x
>> $6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank =
>> 1 '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound =
>> 0, extent = 5, sm = 4 )) )
>> (gdb) s
>> 5         x(1) = 5
>> (gdb) p x
>> $7 = (0, 0, 0, -670762413, 0)
>>
>>
>> Tobias
>>
>> PS: This patch fixes but not necessarily fully the following PRs:
>> PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*)
>> as actual argument to assumed-rank
>> PR fortran/92189 - Fortran-written bind(C) function with allocatable
>> argument does not update C descriptor on exit
>> PR fortran/92621 - Problems with memory handling with allocatable
>> intent(out) arrays with bind(c)
>> PR fortran/101308 - Bind(C): gfortran does not create C descriptors
>> for scalar pointer/allocatable arguments
>> PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling
>> issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
>> PR fortran/92482 - BIND(C) with array-descriptor mishandled for type
>> character
>> and possibly some more.
>>
>> PPS: I should add some additional testcases – I try to do this as
>> Part 2 of this patch.
>>
>> PPPS: Once the patch is in, some audit needs to be done which parts
>> of those PRs remain
>> as follow-up work. I think some still existing issues are covered by
>> José's pending
>> patches + for those which are now fixed, the testcase might still be
>> added.
>>
>> -----------------
>> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße
>> 201, 80634 München; Gesellschaft mit beschränkter Haftung;
>> Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der
>> Gesellschaft: München; Registergericht München, HRB 106955
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Harald Anlauf Oct. 13, 2021, 8:10 p.m. UTC | #4 
Hi Tobias,

Am 13.10.21 um 18:01 schrieb Tobias Burnus:
> Dear all,
>
> a minor update [→ v3].

this has become an impressive work.

> I searched for XFAIL in Sandra's c-interop/ and found
> two remaining true** xfails, now fixed:
>
> - gfortran.dg/c-interop/typecodes-scalar-basic.f90
>    The conversion of scalars of type(c_ptr) was mishandled;
>    fixed now; the fix did run into issues converting a string_cst,
>    which has also been fixed.
>
> - gfortran.dg/c-interop/fc-descriptor-7.f90
>    this one uses TRANSPOSE which did not work [now mostly* does]
>    → PR fortran/101309 now also fixed.
>
> I forgot what the exact issue for the latter was. However, when
> looking at the testcase and extending it, I did run into the
> following issue - and at the end the testcase does now pass.
> The issue I had was that when a contiguous check was requested
> (i.e. only copy in when needed) it failed to work, when
> parmse->expr was (a pointer to) a descriptor. I fixed that and
> now most* things work.
>
> OK for mainline? Comments? Suggestions? More PRs which fixes
> this patch? Regressions? Test results?

Doesn't break my own codes so far.

If nobody else responds within the next days, assume an OK
from my side.

This will also provide Gerhard with a new playground.  ;-)

Thanks for the patch!

Harald

> Tobias
>
> PS: I intent to commit this patch to the OG11 (devel/omp/gcc-11)
> branch, in case someone wants to test it there.
>
> PPS: Nice to have an extensive testcase suite - kudos to Sandra
> in this case. I am sure Gerald will find more issues and once
> it is in, I think I/we have to check some PRs + José's patches
> whether for additional testcases + follow-up fixes.
>
> (*) I write most as passing a (potentially) noncontiguous
> assumed-rank array to a CONTIGUOUS assumed-rank array causes
> an ICE as the scalarizer does not handle dynamic ranks alias
> expr->rank == -1 / ss->dimen = -1.
> I decided that that's a separate issue and filled:
> https://gcc.gnu.org/PR102729
> BTW, my impression is that fixing that PR might fix will solve
> the trans*.c part of https://gcc.gnu.org/PR102641 - but I have
> not investigated.
>
> (**) There are still some 'xfail' in comments (outside dg-*)
> whose tests now pass. And those where for two bugs in the same
> statement, only one is reported - and the other only after fixing
> the first one, which is fine.
>
> On 09.10.21 23:48, Tobias Burnus wrote:
>> Hi all,
>>
>> attached is the updated version. Changes:
>> * Handle noncontiguous arrays – with BIND(C), (g)Fortran needs to make it
>>   contiguous in the caller but also handle noncontiguous in the callee.
>> * Fixes/handle 'character(len=*)' with BIND(C); those always use an
>>   array descriptor - also with explicit-size and assumed-size arrays
>> * Fixed a bunch of bugs, found when writing extensive testcases.
>> * Fixed type(*) handling - those now pass properly type and elem_len
>>   on when calling a new function (bind(C) or not).
>>
>> Besides adding the type itself (which is rather straight forward),
>> this patch only had minor modifications – and then the two big
>> conversion functions.
>>
>> While it looks intimidating, it should be comparably simple to
>> review as everything is on one place and hopefully sufficiently
>> well documented.
>>
>> OK – for mainline?  Other comments? More PRs which are fixed?
>> Issues not yet fixed (which are inside the scope of this patch)?
>>
>> (If this patch is too long, I also have a nine-day old pending patch
>> at https://gcc.gnu.org/pipermail/gcc-patches/2021-October/580624.html )
>>
>> Tobias
>>
>> PS: The following still applies.
>>
>> On 06.09.21 12:52, Tobias Burnus wrote:
>>> gfortran's internal array descriptor (xgfc descriptor) and
>>> the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
>>> of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
>>> procedure the gfc descriptor has to be converted to cfi – and when a
>>> BIND(C) procedure is implemented in Fortran, the argument has to be
>>> converted back from CFI to gfc.
>>>
>>> The current implementation handles part in the FE and part in
>>> libgfortran,
>>> but there were several issues, e.g. PR101635 failed due to alias issues,
>>> debugging wasn't working well, uninitialized memory was used in some
>>> cases
>>> etc.
>>>
>>> This patch now moves descriptor conversion handling to the FE – which
>>> also
>>> can make use of compile-time knowledge, useful both for diagnostic
>>> and to
>>> optimize the code.
>>>
>>> Additionally:
>>> - Some cases where TS29113 mandates that the array descriptor should be
>>>   used now use the array descriptor, in particular character scalars
>>> with
>>>   'len=*' and allocatable/pointer scalars.
>>> - While debugging the alias issue, I simplified 'select rank'. While
>>> some
>>>   special case is needed for assumed-shape arrays, those cannot
>>> appear when
>>>   the argument has the pointer or allocatable attribute. That's not
>>> only a
>>>   missed optimization, pointer/allocatable arrays can also be NULL -
>>> such
>>>   that accessing desc->dim.ubound[rank-1] can be uninitialized memory
>>> ...
>>>
>>> OK?  Comments? Suggestions?
>>>
>>>  * * *
>>>
>>> For some more dumps, see the discussion about the alias issue at:
>>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
>>> ("[RFH] ME optimizes variable assignment away / Fortran bind(C)
>>> descriptor conversion")
>>> plus the original emails:
>>> - https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
>>> - and (correct dump)
>>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html
>>>
>>> Debugging - not ideal but not too bad either. For
>>>   subroutine f(x) bind(C)
>>>     integer :: x(:)
>>> with an uninitialized size-4 array as argument:
>>>
>>> m::f (_x=...) at foo4.f90:3
>>> 3       subroutine f(x) bind(C)
>>> (gdb) p x
>>> Cannot access memory at address 0x38
>>> (gdb) p _x
>>> $6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank =
>>> 1 '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound =
>>> 0, extent = 5, sm = 4 )) )
>>> (gdb) s
>>> 5         x(1) = 5
>>> (gdb) p x
>>> $7 = (0, 0, 0, -670762413, 0)
>>>
>>>
>>> Tobias
>>>
>>> PS: This patch fixes but not necessarily fully the following PRs:
>>> PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*)
>>> as actual argument to assumed-rank
>>> PR fortran/92189 - Fortran-written bind(C) function with allocatable
>>> argument does not update C descriptor on exit
>>> PR fortran/92621 - Problems with memory handling with allocatable
>>> intent(out) arrays with bind(c)
>>> PR fortran/101308 - Bind(C): gfortran does not create C descriptors
>>> for scalar pointer/allocatable arguments
>>> PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling
>>> issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
>>> PR fortran/92482 - BIND(C) with array-descriptor mishandled for type
>>> character
>>> and possibly some more.
>>>
>>> PPS: I should add some additional testcases – I try to do this as
>>> Part 2 of this patch.
>>>
>>> PPPS: Once the patch is in, some audit needs to be done which parts
>>> of those PRs remain
>>> as follow-up work. I think some still existing issues are covered by
>>> José's pending
>>> patches + for those which are now fixed, the testcase might still be
>>> added.
>>>
>>> -----------------
>>> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße
>>> 201, 80634 München; Gesellschaft mit beschränkter Haftung;
>>> Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der
>>> Gesellschaft: München; Registergericht München, HRB 106955
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
> 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
> Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
> Registergericht München, HRB 106955
Paul Richard Thomas Oct. 17, 2021, 3:59 p.m. UTC | #5 
Hi Tobias,

I can only echo Harald's comment that this is an impressive bit of work.

I spent some time messing with fc-descriptor-7.f90/gc-descriptor-7-c.cc
because it kept failing on me. This came about because I missed one of the
chunks not applying in the C component of the test; namely:
  for (int j = 0; j < 5; ++j)
    for (int i = 0; i < 10; ++i)
      {
         subscripts[0] = j; subscripts[1] = i;
         if (*(int *) CFI_address (a, subscripts) != (i+1) + 100*(j+1))
           abort ();
      }

This set me to wondering whether or not the user should be aware that the
result of the transpose intrinsic being passed in this way should not
generate a warning that the CFI API must be used in this case and not to
depend on the data being transposed?

Apart from this I have no other comments, still less corrections :-)

Many thanks for the patch - OK for mainline.

Paul


On Wed, 13 Oct 2021 at 21:11, Harald Anlauf <anlauf@gmx.de> wrote:

> Hi Tobias,
>
> Am 13.10.21 um 18:01 schrieb Tobias Burnus:
> > Dear all,
> >
> > a minor update [→ v3].
>
> this has become an impressive work.
>
> > I searched for XFAIL in Sandra's c-interop/ and found
> > two remaining true** xfails, now fixed:
> >
> > - gfortran.dg/c-interop/typecodes-scalar-basic.f90
> >    The conversion of scalars of type(c_ptr) was mishandled;
> >    fixed now; the fix did run into issues converting a string_cst,
> >    which has also been fixed.
> >
> > - gfortran.dg/c-interop/fc-descriptor-7.f90
> >    this one uses TRANSPOSE which did not work [now mostly* does]
> >    → PR fortran/101309 now also fixed.
> >
> > I forgot what the exact issue for the latter was. However, when
> > looking at the testcase and extending it, I did run into the
> > following issue - and at the end the testcase does now pass.
> > The issue I had was that when a contiguous check was requested
> > (i.e. only copy in when needed) it failed to work, when
> > parmse->expr was (a pointer to) a descriptor. I fixed that and
> > now most* things work.
> >
> > OK for mainline? Comments? Suggestions? More PRs which fixes
> > this patch? Regressions? Test results?
>
> Doesn't break my own codes so far.
>
> If nobody else responds within the next days, assume an OK
> from my side.
>
> This will also provide Gerhard with a new playground.  ;-)
>
> Thanks for the patch!
>
> Harald
>
> > Tobias
> >
> > PS: I intent to commit this patch to the OG11 (devel/omp/gcc-11)
> > branch, in case someone wants to test it there.
> >
> > PPS: Nice to have an extensive testcase suite - kudos to Sandra
> > in this case. I am sure Gerald will find more issues and once
> > it is in, I think I/we have to check some PRs + José's patches
> > whether for additional testcases + follow-up fixes.
> >
> > (*) I write most as passing a (potentially) noncontiguous
> > assumed-rank array to a CONTIGUOUS assumed-rank array causes
> > an ICE as the scalarizer does not handle dynamic ranks alias
> > expr->rank == -1 / ss->dimen = -1.
> > I decided that that's a separate issue and filled:
> > https://gcc.gnu.org/PR102729
> > BTW, my impression is that fixing that PR might fix will solve
> > the trans*.c part of https://gcc.gnu.org/PR102641 - but I have
> > not investigated.
> >
> > (**) There are still some 'xfail' in comments (outside dg-*)
> > whose tests now pass. And those where for two bugs in the same
> > statement, only one is reported - and the other only after fixing
> > the first one, which is fine.
> >
> > On 09.10.21 23:48, Tobias Burnus wrote:
> >> Hi all,
> >>
> >> attached is the updated version. Changes:
> >> * Handle noncontiguous arrays – with BIND(C), (g)Fortran needs to make
> it
> >>   contiguous in the caller but also handle noncontiguous in the callee.
> >> * Fixes/handle 'character(len=*)' with BIND(C); those always use an
> >>   array descriptor - also with explicit-size and assumed-size arrays
> >> * Fixed a bunch of bugs, found when writing extensive testcases.
> >> * Fixed type(*) handling - those now pass properly type and elem_len
> >>   on when calling a new function (bind(C) or not).
> >>
> >> Besides adding the type itself (which is rather straight forward),
> >> this patch only had minor modifications – and then the two big
> >> conversion functions.
> >>
> >> While it looks intimidating, it should be comparably simple to
> >> review as everything is on one place and hopefully sufficiently
> >> well documented.
> >>
> >> OK – for mainline?  Other comments? More PRs which are fixed?
> >> Issues not yet fixed (which are inside the scope of this patch)?
> >>
> >> (If this patch is too long, I also have a nine-day old pending patch
> >> at https://gcc.gnu.org/pipermail/gcc-patches/2021-October/580624.html )
> >>
> >> Tobias
> >>
> >> PS: The following still applies.
> >>
> >> On 06.09.21 12:52, Tobias Burnus wrote:
> >>> gfortran's internal array descriptor (xgfc descriptor) and
> >>> the descriptor used with BIND(C) (CFI descriptor, ISO_Fortran_binding.h
> >>> of TS29113 / Fortran 2018) are different. Thus, when calling a BIND(C)
> >>> procedure the gfc descriptor has to be converted to cfi – and when a
> >>> BIND(C) procedure is implemented in Fortran, the argument has to be
> >>> converted back from CFI to gfc.
> >>>
> >>> The current implementation handles part in the FE and part in
> >>> libgfortran,
> >>> but there were several issues, e.g. PR101635 failed due to alias
> issues,
> >>> debugging wasn't working well, uninitialized memory was used in some
> >>> cases
> >>> etc.
> >>>
> >>> This patch now moves descriptor conversion handling to the FE – which
> >>> also
> >>> can make use of compile-time knowledge, useful both for diagnostic
> >>> and to
> >>> optimize the code.
> >>>
> >>> Additionally:
> >>> - Some cases where TS29113 mandates that the array descriptor should be
> >>>   used now use the array descriptor, in particular character scalars
> >>> with
> >>>   'len=*' and allocatable/pointer scalars.
> >>> - While debugging the alias issue, I simplified 'select rank'. While
> >>> some
> >>>   special case is needed for assumed-shape arrays, those cannot
> >>> appear when
> >>>   the argument has the pointer or allocatable attribute. That's not
> >>> only a
> >>>   missed optimization, pointer/allocatable arrays can also be NULL -
> >>> such
> >>>   that accessing desc->dim.ubound[rank-1] can be uninitialized memory
> >>> ...
> >>>
> >>> OK?  Comments? Suggestions?
> >>>
> >>>  * * *
> >>>
> >>> For some more dumps, see the discussion about the alias issue at:
> >>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578364.html
> >>> ("[RFH] ME optimizes variable assignment away / Fortran bind(C)
> >>> descriptor conversion")
> >>> plus the original emails:
> >>> - https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578271.html
> >>> - and (correct dump)
> >>> https://gcc.gnu.org/pipermail/gcc-patches/2021-August/578274.html
> >>>
> >>> Debugging - not ideal but not too bad either. For
> >>>   subroutine f(x) bind(C)
> >>>     integer :: x(:)
> >>> with an uninitialized size-4 array as argument:
> >>>
> >>> m::f (_x=...) at foo4.f90:3
> >>> 3       subroutine f(x) bind(C)
> >>> (gdb) p x
> >>> Cannot access memory at address 0x38
> >>> (gdb) p _x
> >>> $6 = ( base_addr = 0x7fffffffe2c0, elem_len = 4, version = 1, rank =
> >>> 1 '\001', attribute = 2 '\002', type = 1025, dim = (( lower_bound =
> >>> 0, extent = 5, sm = 4 )) )
> >>> (gdb) s
> >>> 5         x(1) = 5
> >>> (gdb) p x
> >>> $7 = (0, 0, 0, -670762413, 0)
> >>>
> >>>
> >>> Tobias
> >>>
> >>> PS: This patch fixes but not necessarily fully the following PRs:
> >>> PR fortran/102086 - [F2008][TS29113] Accepts invalid scalar TYPE(*)
> >>> as actual argument to assumed-rank
> >>> PR fortran/92189 - Fortran-written bind(C) function with allocatable
> >>> argument does not update C descriptor on exit
> >>> PR fortran/92621 - Problems with memory handling with allocatable
> >>> intent(out) arrays with bind(c)
> >>> PR fortran/101308 - Bind(C): gfortran does not create C descriptors
> >>> for scalar pointer/allocatable arguments
> >>> PR fortran/101635 - FAIL: gfortran.dg/PR93963.f90 – alias-handling
> >>> issue with BIND(C)'s _gfortran_cfi_desc_to_gfc_desc
> >>> PR fortran/92482 - BIND(C) with array-descriptor mishandled for type
> >>> character
> >>> and possibly some more.
> >>>
> >>> PPS: I should add some additional testcases – I try to do this as
> >>> Part 2 of this patch.
> >>>
> >>> PPPS: Once the patch is in, some audit needs to be done which parts
> >>> of those PRs remain
> >>> as follow-up work. I think some still existing issues are covered by
> >>> José's pending
> >>> patches + for those which are now fixed, the testcase might still be
> >>> added.
> >>>
> >>> -----------------
> >>> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße
> >>> 201, 80634 München; Gesellschaft mit beschränkter Haftung;
> >>> Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der
> >>> Gesellschaft: München; Registergericht München, HRB 106955
> > -----------------
> > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
> > 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
> > Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
> > Registergericht München, HRB 106955
>
>
diff mbox series

Patch

Fortran: Fix Bind(C) Array-Descriptor Conversion

gfortran uses internally a different array descriptor ("gfc") as
Fortran 2018 alias TS291113 defines for C interoperability via
ISO_Fortran_binding.h ("CFI").  Hence, when calling a C function
from Fortran, it has to be converted in the callee - and if a
BIND(C) procedure is written in Fortran, the CFI argument has
to be converted to gfc in order work with the rest of the FE
code and the library calls.

Before this patch, part was handled in the FE generated code and
other parts in libgfortran.  With this patch, all code is generated
and CFI is defined as proper type - visible in the debugger and to
the middle end - avoiding both alias issues and missed optimization
issues.

This patch also fixes issues like: intent(out) deallocation in
the bind(C) callee, using the CFI descriptor also for allocatable
and pointer scalars and for len=* character strings.
For 'select rank', it also optimizes the code + avoid accessing
uninitialized memory if the dummy argument is allocatable/a pointer.
It additionally rejects passing a descriptorless type(*) to an
assumed-rank dummy argument. [F2018:C711]

	PR fortran/102086
	PR fortran/92189
	PR fortran/92621
	PR fortran/101308
	PR fortran/101635
	PR fortran/92482

gcc/fortran/ChangeLog:

	* decl.c (gfc_verify_c_interop_param): Remove 'sorry' for
	scalar allocatable/pointer and len=*.
	* expr.c (is_CFI_desc): Return true for for those.
	* gfortran.h (CFI_type_kind_shift, CFI_type_from_type_kind,
	CFI_VERSION, CFI_MAX_RANK, CFI_attribute_pointer,
	CFI_attribute_allocatable, CFI_attribute_other, CFI_type_mask,
	CFI_type_Integer, CFI_type_Logical, CFI_type_Real, CFI_type_Complex,
	CFI_type_Character, CFI_type_struct, CFI_type_cptr,
	CFI_type_cfunptr, CFI_type_other): New #define.
	* interface.c (compare_parameter): Reject descriptorless type(*)
	as dummy to assumed-rank dummy.
	* trans-array.c (CFI_FIELD_BASE_ADDR, CFI_FIELD_ELEM_LEN,
	CFI_FIELD_VERSION, CFI_FIELD_RANK, CFI_FIELD_ATTRIBUTE,
	CFI_FIELD_TYPE, CFI_FIELD_DIM, CFI_DIM_FIELD_LOWER_BOUND,
	CFI_DIM_FIELD_EXTENT, CFI_DIM_FIELD_SM): #define locally.
	(gfc_get_cfi_descriptor_field, gfc_get_cfi_desc_base_addr,
	gfc_get_cfi_desc_elem_len, gfc_get_cfi_desc_version,
	gfc_get_cfi_desc_rank, gfc_get_cfi_desc_type,
	gfc_get_cfi_desc_attribute, gfc_get_cfi_dim_item,
	gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent,
	(gfc_get_cfi_dim_sm): New to access descriptor fields of CFI types.
	(gfc_conv_descriptor_type): Likewise for a gfc descriptor.
	* trans-array.h (gfc_conv_descriptor_type,
	gfc_get_cfi_desc_base_addr, gfc_get_cfi_desc_elem_len,
	gfc_get_cfi_desc_version, gfc_get_cfi_desc_rank,
	gfc_get_cfi_desc_type, gfc_get_cfi_desc_attribute,
	gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent,
	gfc_get_cfi_dim_sm): New prototypes.
	* trans-decl.c
	(gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi): Remove global vars.
	(gfc_build_builtin_function_decls): Don't init them.
	(gfc_get_symbol_decl): Special case for CFI vars.
	(create_function_arglist): Likewise.
	(convert_CFI_desc): Remove.
	(gfc_trans_deferred_vars): Remove call to it.
	(gfc_conv_cfi_to_gfc): New.
	(gfc_generate_function_code): Call it, replace CFI decl by
	GFC decl locally.
	* trans-expr.c (gfc_maybe_dereference_var): Special case for CFI.
	(gfc_conv_gfc_desc_to_cfi_desc): Rewrite to handle everything inline.
	(gfc_conv_procedure_call): Use is_CFI_desc consistently, don't
	deallocate CFI allocatable here, it's done in
	gfc_conv_gfc_desc_to_cfi_desc.
	* trans-openmp.c (gfc_omp_is_optional_argument,
	gfc_omp_check_optional_argument): Update as CFI optionals are
	VAR_DECL.
	* trans-stmt.c (gfc_trans_select_rank_cases): Simplify for
	allocatable/pointer also to avoid accessing uninit memory.
	* trans-types.c (gfc_cfi_descriptor_base): New global var.
	(gfc_get_dtype_rank_type): Permit skipping the init of rank.
	(gfc_sym_type): Add is_bind_c arg + special case for CFI.
	(gfc_get_function_type): Update for CFI args.
	(gfc_get_cfi_dim_type, gfc_get_cfi_type): New.
	* trans-types.h (gfc_sym_type, gfc_get_cfi_type): New/update
	prototype.
	* trans.c (gfc_trans_runtime_check): Cleanup, avoid type issue
	if !once.
	* trans.h (gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi):
	Remove global var decl.

libgfortran/ChangeLog:

	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc,
	gfc_desc_to_cfi_desc): Note that those are for legacy code.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/optional-bind-c.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/ISO_Fortran_binding_4.f90: Extend; add kind=4
	character test.
	* gfortran.dg/PR100915.c: Expect c_funptr_t.
	* gfortran.dg/PR100915.f90: Likewise.
	* gfortran.dg/PR93963.f90: Extend; non-alloc/pointer test
	and make fix test calls.
	* gfortran.dg/bind-c-intent-out.f90: Use dg-do run; update
	expectations for the original dumps.
	* gfortran.dg/bind_c_array_params_2.f90: Likewise.
	* gfortran.dg/bind_c_char_10.f90: Likewise.
	* gfortran.dg/bind_c_char_8.f90: Remove sorry cases.
	* gfortran.dg/iso_c_binding_char_1.f90: Likewise.
	* gfortran.dg/c-interop/typecodes-array-char-c.c: Add len=5 char
	test for kind=1/kind=4.
	* gfortran.dg/c-interop/typecodes-array-char.f90: Likewise.
	* gfortran.dg/c-interop/allocatable-dummy.f90: Remove xfail/sorry.
	* gfortran.dg/c-interop/c1255-1.f90: Likewise.
	* gfortran.dg/c-interop/c407c-1.f90: Likewise.
	* gfortran.dg/c-interop/cf-descriptor-5.f90: Likewise.
	* gfortran.dg/c-interop/cf-out-descriptor-3.f90: Likewise.
	* gfortran.dg/c-interop/cf-out-descriptor-4.f90: Likewise.
	* gfortran.dg/c-interop/cf-out-descriptor-5.f90: Likewise.
	* gfortran.dg/c-interop/deferred-character-1.f90: Likewise.
	* gfortran.dg/c-interop/deferred-character-2.f90: Likewise.
	* gfortran.dg/c-interop/fc-descriptor-3.f90: Likewise.
	* gfortran.dg/c-interop/fc-descriptor-5.f90: Likewise.
	* gfortran.dg/c-interop/fc-descriptor-6.f90: Likewise.
	* gfortran.dg/c-interop/fc-out-descriptor-3.f90: Likewise.
	* gfortran.dg/c-interop/fc-out-descriptor-4.f90: Likewise.
	* gfortran.dg/c-interop/fc-out-descriptor-5.f90: Likewise.
	* gfortran.dg/c-interop/fc-out-descriptor-6.f90: Likewise.
	* gfortran.dg/c-interop/ff-descriptor-5.f90: Likewise.
	* gfortran.dg/c-interop/typecodes-scalar-float128.f90: Likewise.
	* gfortran.dg/c-interop/typecodes-scalar-int128.f90: Likewise.
	* gfortran.dg/c-interop/typecodes-scalar-longdouble.f90: Likewise.
	* gfortran.dg/ISO_Fortran_binding_19.f90: New test.
	* gfortran.dg/assumed_type_12.f90: New test.
	* gfortran.dg/bind-c-char-descr.f90: New test.

 gcc/fortran/decl.c                                 |  23 -
 gcc/fortran/expr.c                                 |   8 +-
 gcc/fortran/gfortran.h                             |  31 +-
 gcc/fortran/interface.c                            |  15 +
 gcc/fortran/trans-array.c                          | 119 ++++
 gcc/fortran/trans-array.h                          |  13 +
 gcc/fortran/trans-decl.c                           | 632 ++++++++++++++++-----
 gcc/fortran/trans-expr.c                           | 581 ++++++++++++++-----
 gcc/fortran/trans-openmp.c                         |   6 +-
 gcc/fortran/trans-stmt.c                           |  44 +-
 gcc/fortran/trans-types.c                          | 108 +++-
 gcc/fortran/trans-types.h                          |   3 +-
 gcc/fortran/trans.c                                |  11 +-
 gcc/fortran/trans.h                                |   2 -
 .../gfortran.dg/ISO_Fortran_binding_19.f90         |  27 +
 .../gfortran.dg/ISO_Fortran_binding_4.f90          |  22 +-
 gcc/testsuite/gfortran.dg/PR100915.c               |   2 +-
 gcc/testsuite/gfortran.dg/PR100915.f90             |  13 +-
 gcc/testsuite/gfortran.dg/PR93963.f90              |  80 ++-
 gcc/testsuite/gfortran.dg/assumed_type_12.f90      |  35 ++
 gcc/testsuite/gfortran.dg/bind-c-char-descr.f90    |  82 +++
 gcc/testsuite/gfortran.dg/bind-c-intent-out.f90    |  13 +-
 .../gfortran.dg/bind_c_array_params_2.f90          |  30 +-
 gcc/testsuite/gfortran.dg/bind_c_char_10.f90       |  25 +-
 gcc/testsuite/gfortran.dg/bind_c_char_8.f90        |  10 +-
 .../gfortran.dg/c-interop/allocatable-dummy.f90    |   2 +-
 gcc/testsuite/gfortran.dg/c-interop/c1255-1.f90    |   2 +-
 gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90    |   4 +-
 .../gfortran.dg/c-interop/cf-descriptor-5.f90      |   2 +-
 .../gfortran.dg/c-interop/cf-out-descriptor-3.f90  |   2 +-
 .../gfortran.dg/c-interop/cf-out-descriptor-4.f90  |   2 +-
 .../gfortran.dg/c-interop/cf-out-descriptor-5.f90  |   6 +-
 .../gfortran.dg/c-interop/deferred-character-1.f90 |   4 +-
 .../gfortran.dg/c-interop/deferred-character-2.f90 |   2 +-
 .../gfortran.dg/c-interop/fc-descriptor-3.f90      |   2 +-
 .../gfortran.dg/c-interop/fc-descriptor-5.f90      |   2 +-
 .../gfortran.dg/c-interop/fc-descriptor-6.f90      |   2 +-
 .../gfortran.dg/c-interop/fc-out-descriptor-3.f90  |   2 +-
 .../gfortran.dg/c-interop/fc-out-descriptor-4.f90  |   2 +-
 .../gfortran.dg/c-interop/fc-out-descriptor-5.f90  |   4 +-
 .../gfortran.dg/c-interop/fc-out-descriptor-6.f90  |   2 +-
 .../gfortran.dg/c-interop/ff-descriptor-5.f90      |   4 +-
 .../gfortran.dg/c-interop/typecodes-array-char-c.c |   6 +
 .../gfortran.dg/c-interop/typecodes-array-char.f90 |  10 +
 .../c-interop/typecodes-scalar-float128.f90        |   2 +-
 .../c-interop/typecodes-scalar-int128.f90          |   2 +-
 .../c-interop/typecodes-scalar-longdouble.f90      |   2 +-
 gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 |   3 +-
 libgfortran/ISO_Fortran_binding-1-tmpl.h           |   8 +-
 libgfortran/runtime/ISO_Fortran_binding.c          |   4 +
 .../testsuite/libgomp.fortran/optional-bind-c.f90  |  18 +
 51 files changed, 1598 insertions(+), 438 deletions(-)

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2e49a673e15..f636b9be712 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1588,15 +1588,6 @@  gfc_verify_c_interop_param (gfc_symbol *sym)
 					    sym->name, &sym->declared_at,
 					    sym->ns->proc_name->name))
 		    retval = false;
-		  else if (!sym->attr.dimension)
-		    {
-		      /* FIXME: Use CFI array descriptor for scalars.  */
-		      gfc_error ("Sorry, deferred-length scalar character dummy "
-				 "argument %qs at %L of procedure %qs with "
-				 "BIND(C) not yet supported", sym->name,
-				 &sym->declared_at, sym->ns->proc_name->name);
-		      retval = false;
-		    }
 		}
 	      else if (sym->attr.value
 		       && (!cl || !cl->length
@@ -1619,20 +1610,6 @@  gfc_verify_c_interop_param (gfc_symbol *sym)
 				      "attribute", sym->name, &sym->declared_at,
 				      sym->ns->proc_name->name))
 		    retval = false;
-		  else if (!sym->attr.dimension
-			   || sym->as->type == AS_ASSUMED_SIZE
-			   || sym->as->type == AS_EXPLICIT)
-		    {
-		      /* FIXME: Valid - should use the CFI array descriptor, but
-			 not yet handled for scalars and assumed-/explicit-size
-			 arrays.  */
-		      gfc_error ("Sorry, character dummy argument %qs at %L "
-				 "with assumed length is not yet supported for "
-				 "procedure %qs with BIND(C) attribute",
-				 sym->name, &sym->declared_at,
-				 sym->ns->proc_name->name);
-		      retval = false;
-		    }
 		}
 	      else if (cl->length->expr_type != EXPR_CONSTANT
 		       || mpz_cmp_si (cl->length->value.integer, 1) != 0)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 35563a78697..0560f5b8c43 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1078,11 +1078,13 @@  is_CFI_desc (gfc_symbol *sym, gfc_expr *e)
 
   if (sym && sym->attr.dummy
       && sym->ns->proc_name->attr.is_bind_c
-      && sym->attr.dimension
       && (sym->attr.pointer
 	  || sym->attr.allocatable
-	  || sym->as->type == AS_ASSUMED_SHAPE
-	  || sym->as->type == AS_ASSUMED_RANK))
+	  || (sym->attr.dimension
+	      && (sym->as->type == AS_ASSUMED_SHAPE
+		  || sym->as->type == AS_ASSUMED_RANK))
+	  || (sym->ts.type == BT_CHARACTER
+	      && (!sym->ts.u.cl || !sym->ts.u.cl->length))))
     return true;
 
 return false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fdf556eef3d..cdaa8fb68de 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -48,7 +48,6 @@  not after.
    libgfortran/libgfortran_frontend.h  */
 #include "libgfortran.h"
 
-
 #include "intl.h"
 #include "splay-tree.h"
 
@@ -105,6 +104,36 @@  typedef struct
 }
 mstring;
 
+/* ISO_Fortran_binding.h
+   CAUTION: This has to be kept in sync with libgfortran.  */
+
+#define CFI_type_kind_shift 8
+#define CFI_type_from_type_kind(t, k) (t + (k << CFI_type_kind_shift))
+
+/* Constants, defined as macros. */
+#define CFI_VERSION 1
+#define CFI_MAX_RANK 15
+
+/* Attributes. */
+#define CFI_attribute_pointer 0
+#define CFI_attribute_allocatable 1
+#define CFI_attribute_other 2
+
+#define CFI_type_mask 0xFF
+#define CFI_type_kind_shift 8
+
+/* Intrinsic types. Their kind number defines their storage size. */
+#define CFI_type_Integer 1
+#define CFI_type_Logical 2
+#define CFI_type_Real 3
+#define CFI_type_Complex 4
+#define CFI_type_Character 5
+
+/* Types with no kind. */
+#define CFI_type_struct 6
+#define CFI_type_cptr 7
+#define CFI_type_cfunptr 8
+#define CFI_type_other -1
 
 
 /*************************** Enums *****************************/
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa9da9..d49f71d31f6 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2448,6 +2448,21 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return false;
     }
 
+  /* F2018, C711.  */
+  if (actual->ts.type == BT_ASSUMED
+      && formal->attr.dimension
+      && formal->as->type == AS_ASSUMED_RANK
+      && (!actual->symtree->n.sym->attr.dimension
+	  || (actual->symtree->n.sym->as->type != AS_ASSUMED_RANK
+	      && actual->symtree->n.sym->as->type != AS_ASSUMED_SHAPE)))
+    {
+      if (where)
+	gfc_error ("Assumed-type actual argument at %L must be of assumed rank"
+		   " or assumed shape as dummy argument %qs has assumed rank",
+		   &actual->where, formal->name);
+      return false;
+    }
+
   /* F2008, 12.5.2.5; IR F08/0073.  */
   if (formal->ts.type == BT_CLASS && formal->attr.class_ok
       && actual->expr_type != EXPR_NULL
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013defdbb..543de55bdb2 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -103,6 +103,111 @@  gfc_array_dataptr_type (tree desc)
   return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
 }
 
+/* Build expressions to access members of the CFI descriptor.  */
+#define CFI_FIELD_BASE_ADDR 0
+#define CFI_FIELD_ELEM_LEN 1
+#define CFI_FIELD_VERSION 2
+#define CFI_FIELD_RANK 3
+#define CFI_FIELD_ATTRIBUTE 4
+#define CFI_FIELD_TYPE 5
+#define CFI_FIELD_DIM 6
+
+#define CFI_DIM_FIELD_LOWER_BOUND 0
+#define CFI_DIM_FIELD_EXTENT 1
+#define CFI_DIM_FIELD_SM 2
+
+static tree
+gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
+{
+  tree type = TREE_TYPE (desc);
+  gcc_assert (TREE_CODE (type) == RECORD_TYPE
+	      && TYPE_FIELDS (type)
+	      && (strcmp ("base_addr",
+			 IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type))))
+		  == 0));
+  tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+  gcc_assert (field != NULL_TREE);
+
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  desc, field, NULL_TREE);
+}
+
+tree
+gfc_get_cfi_desc_base_addr (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
+}
+
+tree
+gfc_get_cfi_desc_elem_len (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
+}
+
+tree
+gfc_get_cfi_desc_version (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
+}
+
+tree
+gfc_get_cfi_desc_rank (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
+}
+
+tree
+gfc_get_cfi_desc_type (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
+}
+
+tree
+gfc_get_cfi_desc_attribute (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
+}
+
+static tree
+gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
+{
+  tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
+  tmp = gfc_build_array_ref (tmp, idx, NULL);
+  tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
+  gcc_assert (field != NULL_TREE);
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  tmp, field, NULL_TREE);
+}
+
+tree
+gfc_get_cfi_dim_lbound (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
+}
+
+tree
+gfc_get_cfi_dim_extent (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
+}
+
+tree
+gfc_get_cfi_dim_sm (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_SM);
+}
+
+#undef CFI_FIELD_BASE_ADDR
+#undef CFI_FIELD_ELEM_LEN
+#undef CFI_FIELD_VERSION
+#undef CFI_FIELD_RANK
+#undef CFI_FIELD_ATTRIBUTE
+#undef CFI_FIELD_TYPE
+#undef CFI_FIELD_DIM
+
+#undef CFI_DIM_FIELD_LOWER_BOUND
+#undef CFI_DIM_FIELD_EXTENT
+#undef CFI_DIM_FIELD_SM
 
 /* Build expressions to access the members of an array descriptor.
    It's surprisingly easy to mess up here, so never access
@@ -288,6 +393,20 @@  gfc_conv_descriptor_attribute (tree desc)
 			  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_type (tree desc)
+{
+  tree tmp;
+  tree dtype;
+
+  dtype = gfc_conv_descriptor_dtype (desc);
+  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
+  gcc_assert (tmp!= NULL_TREE
+	      && TREE_TYPE (tmp) == signed_char_type_node);
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+			  dtype, tmp, NULL_TREE);
+}
+
 tree
 gfc_get_descriptor_dimension (tree desc)
 {
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4d443d7118..f60ee7a377a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -173,6 +173,7 @@  tree gfc_conv_descriptor_dtype (tree);
 tree gfc_conv_descriptor_rank (tree);
 tree gfc_conv_descriptor_elem_len (tree);
 tree gfc_conv_descriptor_attribute (tree);
+tree gfc_conv_descriptor_type (tree);
 tree gfc_get_descriptor_dimension (tree);
 tree gfc_conv_descriptor_stride_get (tree, tree);
 tree gfc_conv_descriptor_lbound_get (tree, tree);
@@ -186,6 +187,18 @@  void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
 
+/* CFI descriptor.  */
+tree gfc_get_cfi_desc_base_addr (tree);
+tree gfc_get_cfi_desc_elem_len (tree);
+tree gfc_get_cfi_desc_version (tree);
+tree gfc_get_cfi_desc_rank (tree);
+tree gfc_get_cfi_desc_type (tree);
+tree gfc_get_cfi_desc_attribute (tree);
+tree gfc_get_cfi_dim_lbound (tree, tree);
+tree gfc_get_cfi_dim_extent (tree, tree);
+tree gfc_get_cfi_dim_sm (tree, tree);
+
+
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bed61e2325d..c22f1ac2de6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -117,8 +117,6 @@  tree gfor_fndecl_fdate;
 tree gfor_fndecl_ttynam;
 tree gfor_fndecl_in_pack;
 tree gfor_fndecl_in_unpack;
-tree gfor_fndecl_cfi_to_gfc;
-tree gfor_fndecl_gfc_to_cfi;
 tree gfor_fndecl_associated;
 tree gfor_fndecl_system_clock4;
 tree gfor_fndecl_system_clock8;
@@ -1548,6 +1546,14 @@  gfc_get_symbol_decl (gfc_symbol * sym)
 	      || (sym->module && sym->attr.if_source != IFSRC_DECL
 		  && sym->backend_decl));
 
+  if (sym->attr.dummy && sym->ns->proc_name->attr.is_bind_c
+      && is_CFI_desc (sym, NULL))
+    {
+      gcc_assert (sym->backend_decl && (sym->ts.type != BT_CHARACTER
+					|| sym->ts.u.cl->backend_decl));
+      return sym->backend_decl;
+    }
+
   if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function)
     byref = gfc_return_by_reference (sym->ns->proc_name);
   else
@@ -1595,9 +1601,6 @@  gfc_get_symbol_decl (gfc_symbol * sym)
       sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
     }
 
-  if (is_CFI_desc (sym, NULL))
-    gfc_defer_symbol_init (sym);
-
   fun_or_res = byref && (sym->attr.result
 			 || (sym->attr.function && sym->ts.deferred));
   if ((sym->attr.dummy && ! sym->attr.function) || fun_or_res)
@@ -2755,9 +2758,19 @@  create_function_arglist (gfc_symbol * sym)
       if (f->sym->attr.volatile_)
 	type = build_qualified_type (type, TYPE_QUAL_VOLATILE);
 
-      /* Build the argument declaration.  */
-      parm = build_decl (input_location,
-			 PARM_DECL, gfc_sym_identifier (f->sym), type);
+      /* Build the argument declaration. For C descriptors, we use a
+	 '_'-prefixed name as the decl inside the proc uses the
+	 sym->name. */
+      tree parm_name;
+      if (sym->attr.is_bind_c && is_CFI_desc (f->sym, NULL))
+	{
+	  strcpy (&name[1], f->sym->name);
+	  name[0] = '_';
+	  parm_name = get_identifier (name);
+	}
+      else
+	parm_name = gfc_sym_identifier (f->sym);
+      parm = build_decl (input_location, PARM_DECL, parm_name, type);
 
       if (f->sym->attr.volatile_)
 	{
@@ -3834,19 +3847,6 @@  gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX("internal_unpack")), ". w R ",
 	void_type_node, 2, pvoid_type_node, pvoid_type_node);
 
-  /* These two builtins write into what the first argument points to and
-     read from what the second argument points to, but we can't use R
-     for that, because the directly pointed structure contains a pointer
-     which is copied into the descriptor pointed by the first argument,
-     effectively escaping that way.  See PR92123.  */
-  gfor_fndecl_cfi_to_gfc = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("cfi_desc_to_gfc_desc")), ". w . ",
-	void_type_node, 2, pvoid_type_node, ppvoid_type_node);
-
-  gfor_fndecl_gfc_to_cfi = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("gfc_desc_to_cfi_desc")), ". w . ",
-	void_type_node, 2, ppvoid_type_node, pvoid_type_node);
-
   gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("associated")), ". R R ",
 	integer_type_node, 2, ppvoid_type_node, ppvoid_type_node);
@@ -4464,115 +4464,6 @@  gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
 }
 
 
-/* Convert CFI descriptor dummies into gfc types and back again.  */
-static void
-convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
-{
-  tree gfc_desc;
-  tree gfc_desc_ptr;
-  tree CFI_desc;
-  tree CFI_desc_ptr;
-  tree dummy_ptr;
-  tree tmp;
-  tree present;
-  tree incoming;
-  tree outgoing;
-  stmtblock_t outer_block;
-  stmtblock_t tmpblock;
-
-  /* dummy_ptr will be the pointer to the passed array descriptor,
-     while CFI_desc is the descriptor itself.  */
-  if (DECL_LANG_SPECIFIC (sym->backend_decl))
-    CFI_desc = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
-  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (sym->backend_decl))))
-    CFI_desc = sym->backend_decl;
-  else
-    CFI_desc = NULL;
-
-  dummy_ptr = CFI_desc;
-
-  if (CFI_desc)
-    {
-      CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
-
-      /* The compiler will have given CFI_desc the correct gfortran
-	 type. Use this new variable to store the converted
-	 descriptor.  */
-      gfc_desc = gfc_create_var (TREE_TYPE (CFI_desc), "gfc_desc");
-      tmp = build_pointer_type (TREE_TYPE (gfc_desc));
-      gfc_desc_ptr = gfc_create_var (tmp, "gfc_desc_ptr");
-      CFI_desc_ptr = gfc_create_var (pvoid_type_node, "CFI_desc_ptr");
-
-      /* Fix the condition for the presence of the argument.  */
-      gfc_init_block (&outer_block);
-      present = fold_build2_loc (input_location, NE_EXPR,
-				 logical_type_node, dummy_ptr,
-				 build_int_cst (TREE_TYPE (dummy_ptr), 0));
-
-      gfc_init_block (&tmpblock);
-      /* Pointer to the gfc descriptor.  */
-      gfc_add_modify (&tmpblock, gfc_desc_ptr,
-		      gfc_build_addr_expr (NULL, gfc_desc));
-      /* Store the pointer to the CFI descriptor.  */
-      gfc_add_modify (&tmpblock, CFI_desc_ptr,
-		      fold_convert (pvoid_type_node, dummy_ptr));
-      tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-      /* Convert the CFI descriptor.  */
-      incoming = build_call_expr_loc (input_location,
-			gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
-      gfc_add_expr_to_block (&tmpblock, incoming);
-      /* Set the dummy pointer to point to the gfc_descriptor.  */
-      gfc_add_modify (&tmpblock, dummy_ptr,
-		      fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr));
-
-      /* The hidden string length is not passed to bind(C) procedures so set
-	 it from the descriptor element length.  */
-      if (sym->ts.type == BT_CHARACTER
-	  && sym->ts.u.cl->backend_decl
-	  && VAR_P (sym->ts.u.cl->backend_decl))
-	{
-	  tmp = build_fold_indirect_ref_loc (input_location, dummy_ptr);
-	  tmp = gfc_conv_descriptor_elem_len (tmp);
-	  gfc_add_modify (&tmpblock, sym->ts.u.cl->backend_decl,
-			  fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
-				        tmp));
-	}
-
-      /* Check that the argument is present before executing the above.  */
-      incoming = build3_v (COND_EXPR, present,
-			   gfc_finish_block (&tmpblock),
-			   build_empty_stmt (input_location));
-      gfc_add_expr_to_block (&outer_block, incoming);
-      incoming = gfc_finish_block (&outer_block);
-
-      /* Convert the gfc descriptor back to the CFI type before going
-	 out of scope, if the CFI type was present at entry.  */
-      outgoing = NULL_TREE;
-      if ((sym->attr.pointer || sym->attr.allocatable)
-	  && !sym->attr.value
-	  && sym->attr.intent != INTENT_IN)
-	{
-	  gfc_init_block (&outer_block);
-	  gfc_init_block (&tmpblock);
-
-	  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-	  outgoing = build_call_expr_loc (input_location,
-					  gfor_fndecl_gfc_to_cfi, 2,
-					  tmp, gfc_desc_ptr);
-	  gfc_add_expr_to_block (&tmpblock, outgoing);
-
-	  outgoing = build3_v (COND_EXPR, present,
-			       gfc_finish_block (&tmpblock),
-			       build_empty_stmt (input_location));
-	  gfc_add_expr_to_block (&outer_block, outgoing);
-	  outgoing = gfc_finish_block (&outer_block);
-	}
-
-      /* Add the lot to the procedure init and finally blocks.  */
-      gfc_add_init_cleanup (block, incoming, outgoing);
-    }
-}
-
 /* Get the result expression for a procedure.  */
 
 static tree
@@ -5149,13 +5040,6 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	}
       else if (!(UNLIMITED_POLY(sym)) && !is_pdt_type)
 	gcc_unreachable ();
-
-      /* Assumed shape and assumed rank arrays are passed to BIND(C) procedures
-	 as ISO Fortran Interop descriptors. These have to be converted to
-	 gfortran descriptors and back again.  This has to be done here so that
-	 the conversion occurs at the start of the init block.  */
-      if (is_CFI_desc (sym, NULL))
-	convert_CFI_desc (block, sym);
     }
 
   gfc_init_block (&tmpblock);
@@ -6779,6 +6663,400 @@  finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
   return;
 }
 
+static void
+gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
+		     tree cfi_desc, tree gfc_desc, gfc_symbol *sym)
+{
+  stmtblock_t block;
+  gfc_init_block (&block);
+  tree cfi = build_fold_indirect_ref_loc (input_location, cfi_desc);
+  tree rank, label_loop, label_end, idx, etype, tmp, tmp2;
+
+  /* When allocatable + intent out, free the cfi descriptor.  */
+  if (sym->attr.allocatable && sym->attr.intent == INTENT_OUT)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tree call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, tmp);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      gfc_add_modify (&block, tmp,
+		      fold_convert (TREE_TYPE (tmp), null_pointer_node));
+    }
+
+  if (!sym->attr.referenced)
+    goto done;
+
+  /* Set string length for len=* and len=:, otherwise, it is already set.  */
+  if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
+    {
+      tmp = fold_convert (gfc_array_index_type,
+			  gfc_get_cfi_desc_elem_len (cfi));
+      if (sym->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_array_index_type, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      sym->ts.kind));
+      gfc_add_modify (&block, sym->ts.u.cl->backend_decl, tmp);
+    }
+  /* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr. */
+  if (!sym->attr.dimension)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, gfc_desc,
+		      fold_convert (TREE_TYPE (gfc_desc), tmp));
+      goto done;
+    }
+
+   /* gfc->dtype = ... (from declaration, not from cfi).  */
+  etype = gfc_get_element_type (TREE_TYPE (gfc_desc));
+  gfc_add_modify (&block, gfc_conv_descriptor_dtype (gfc_desc),
+		  gfc_get_dtype_rank_type (sym->as->rank, etype));
+
+  /* gfc->data = cfi->base_addr. */
+  gfc_conv_descriptor_data_set (&block, gfc_desc,
+				gfc_get_cfi_desc_base_addr (cfi));
+
+  /* -fcheck=bound: Do version, rank, attribute, type and is-NULL checks.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      char *msg;
+      tree tmp3;
+      msg = xasprintf ("Unexpected version %%d (expected %d) in CFI descriptor "
+		       "passed to dummy argument %s", CFI_VERSION, sym->name);
+      tmp2 = gfc_get_cfi_desc_version (cfi);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp2,
+			     build_int_cst (TREE_TYPE (tmp2), CFI_VERSION));
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp2);
+      free (msg);
+
+      msg = xasprintf ("Invalid rank %%d (expected 0..%d) in CFI descriptor "
+		       "passed to dummy argument %s", CFI_MAX_RANK, sym->name);
+      tmp3 = tmp2 = tmp = gfc_get_cfi_desc_rank (cfi);
+      tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, tmp,
+			     build_int_cst (TREE_TYPE (tmp), 0));
+      tmp2 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp2,
+			      build_int_cst (TREE_TYPE (tmp2), CFI_MAX_RANK));
+      tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+			     tmp, tmp2);
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp3);
+      free (msg);
+
+      tmp3 = tmp = gfc_get_cfi_desc_attribute (cfi);
+      if (sym->attr.allocatable || sym->attr.pointer)
+	{
+	  int attr = (sym->attr.pointer ? CFI_attribute_pointer
+					: CFI_attribute_allocatable);
+	  msg = xasprintf ("Invalid attribute %%d (expected %d) in CFI "
+			   "descriptor passed to %s dummy argument %s", attr,
+			   sym->attr.pointer ? "pointer" : "allocatable",
+			   sym->name);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 tmp, build_int_cst (TREE_TYPE (tmp), attr));
+	}
+      else
+	{
+	  int amin = MIN (CFI_attribute_pointer,
+			  MIN (CFI_attribute_allocatable, CFI_attribute_other));
+	  int amax = MAX (CFI_attribute_pointer,
+			  MAX (CFI_attribute_allocatable, CFI_attribute_other));
+	  msg = xasprintf ("Invalid attribute %%d (expected %d..%d) in CFI "
+			   "descriptor passed to nonallocatable, nonpointer "
+			   "dummy argument %s", amin, amax, sym->name);
+	  tmp2 = tmp;
+	  tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, tmp,
+			     build_int_cst (TREE_TYPE (tmp), amin));
+	  tmp2 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp2,
+			     build_int_cst (TREE_TYPE (tmp2), amax));
+	  tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				 boolean_type_node, tmp, tmp2);
+	  gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+				   msg, tmp3);
+	  free (msg);
+	  msg = xasprintf ("Invalid unallocatated/unassociated CFI "
+			   "descriptor passed to nonallocatable, nonpointer "
+			   "dummy argument %s", sym->name);
+	  tmp3 = tmp = gfc_get_cfi_desc_base_addr (cfi),
+	  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 tmp, null_pointer_node);
+	}
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp3);
+      free (msg);
+
+      if (sym->ts.type != BT_ASSUMED)
+	{
+	  int type = CFI_type_other;
+	  if (sym->ts.f90_type == BT_VOID)
+	    {
+	      type = (sym->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+		      ? CFI_type_cfunptr : CFI_type_cptr);
+	    }
+	  else
+	    switch (sym->ts.type)
+	      {
+		case BT_INTEGER:
+		case BT_LOGICAL:
+		case BT_REAL:
+		case BT_COMPLEX:
+		  type = CFI_type_from_type_kind (sym->ts.type, sym->ts.kind);
+		  break;
+		case BT_CHARACTER:
+		  type = CFI_type_from_type_kind (CFI_type_Character,
+						  sym->ts.kind);
+		  break;
+		case BT_DERIVED:
+		  type = CFI_type_struct;
+		  break;
+		case BT_VOID:
+		  type = (sym->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+			? CFI_type_cfunptr : CFI_type_cptr);
+		  break;
+		case BT_ASSUMED:
+		case BT_CLASS:
+		case BT_PROCEDURE:
+		case BT_HOLLERITH:
+		case BT_UNION:
+		case BT_BOZ:
+		case BT_UNKNOWN:
+		  gcc_unreachable ();
+	    }
+	  msg = xasprintf ("Unexpected type %%d (expected %d) in CFI descriptor"
+			   " passed to dummy argument %s", type, sym->name);
+	  tmp2 = tmp = gfc_get_cfi_desc_type (cfi);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 tmp, build_int_cst (TREE_TYPE (tmp), type));
+	  gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp2);
+	  free (msg);
+	}
+    }
+
+  /* Set gfc->dtype.rank, if assumed-rank.  */
+  if (sym->as->rank < 0)
+    {
+      rank = gfc_get_cfi_desc_rank (cfi);
+      gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
+    }
+  else
+    rank = build_int_cst (signed_char_type_node, sym->as->rank);
+
+  /* If cfi->data != NULL. */
+  stmtblock_t block2;
+  gfc_init_block (&block2);
+
+  /* gfc->dspan = ((cfi->dim[0].sm % cfi->elem_len)
+		   ? cfi->dim[0].sm : cfi->elem_len).  */
+  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+			 gfc_array_index_type, tmp,
+			 fold_convert (gfc_array_index_type,
+				       gfc_get_cfi_desc_elem_len (cfi)));
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, gfc_index_zero_node);
+  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+		    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]),
+		    fold_convert (gfc_array_index_type,
+				  gfc_get_cfi_desc_elem_len (cfi)));
+  gfc_conv_descriptor_span_set (&block2, gfc_desc, tmp);
+
+  /* Calculate offset + set lbound, ubound and stride.  */
+  gfc_conv_descriptor_offset_set (&block2, gfc_desc, gfc_index_zero_node);
+  if (sym->as->rank > 0 && !sym->attr.pointer && !sym->attr.allocatable)
+    for (int i = 0; i < sym->as->rank; ++i)
+      {
+	gfc_se se;
+	gfc_init_se (&se, NULL );
+	if (sym->as->lower[i])
+	  {
+	    gfc_conv_expr (&se, sym->as->lower[i]);
+	    tmp = se.expr;
+	  }
+	else
+	  tmp = gfc_index_one_node;
+	gfc_add_block_to_block (&block2, &se.pre);
+	gfc_conv_descriptor_lbound_set (&block2, gfc_desc, gfc_rank_cst[i],
+					tmp);
+	gfc_add_block_to_block (&block2, &se.post);
+      }
+
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  label_loop = gfc_build_label_decl (NULL_TREE);
+  label_end = gfc_build_label_decl (NULL_TREE);
+  idx = gfc_create_var (TREE_TYPE (rank), "idx");
+  gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+  TREE_USED (label_loop) = 1;
+  tmp = build1_v (LABEL_EXPR, label_loop);
+  gfc_add_expr_to_block (&block2, tmp);
+  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx, rank);
+  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* Loop body.  */
+  /* gfc->dim[i].lbound = ... */
+  if (sym->attr.pointer || sym->attr.allocatable)
+    {
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&block2, gfc_desc, idx, tmp);
+    }
+  else if (sym->as->rank < 0)
+    gfc_conv_descriptor_lbound_set (&block2, gfc_desc, idx, gfc_index_one_node);
+
+  /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx),
+			     gfc_index_one_node);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+  gfc_conv_descriptor_ubound_set (&block2, gfc_desc, idx, tmp);
+
+  /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+  tmp = gfc_get_cfi_dim_sm (cfi, idx);
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+   gfc_conv_descriptor_stride_set (&block2, gfc_desc, idx, tmp);
+
+  /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc_desc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc_desc), tmp);
+  gfc_conv_descriptor_offset_set (&block2, gfc_desc, tmp);
+
+  /* End of loop body.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node, idx,
+			 build_int_cst (signed_char_type_node, 1));
+  gfc_add_modify (&block2, idx, tmp);
+  gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+  TREE_USED (label_end) = 1;
+  tmp = build1_v (LABEL_EXPR, label_end);
+  gfc_add_expr_to_block (&block2, tmp);
+
+  if (sym->attr.allocatable || sym->attr.pointer)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi),
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, null_pointer_node);
+      tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    gfc_add_block_to_block (&block, &block2);
+
+done:
+  /* If optional arg: 'if (arg) { block } else { local_arg = NULL; }'.  */
+  if (sym->attr.optional)
+    {
+      tree present = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, cfi_desc,
+				      null_pointer_node);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     sym->backend_decl,
+			     fold_convert (TREE_TYPE (sym->backend_decl),
+					   null_pointer_node));
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block), tmp);
+      gfc_add_expr_to_block (init, tmp);
+    }
+  else
+    gfc_add_block_to_block (init, &block);
+
+  /* Nothing to do if either not referenced or pointer not changed.  */
+  if (!sym->attr.referenced
+      || ((!sym->attr.pointer && !sym->attr.allocatable)
+	  || sym->attr.intent == INTENT_IN))
+    return;
+
+  /* Update pointer + array data data on exit.  */
+  gfc_init_block (&block);
+  tmp = gfc_get_cfi_desc_base_addr (cfi);
+  tmp2 = (!sym->attr.dimension
+	       ? gfc_desc : gfc_conv_descriptor_data_get (gfc_desc));
+  gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
+
+  /* Set string length for len=:, only.  */
+  if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
+    {
+      tmp = sym->ts.u.cl->backend_decl;
+      if (sym->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, MULT_EXPR,
+			       gfc_array_index_type,
+			       sym->ts.u.cl->backend_decl, tmp);
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
+
+  if (!sym->attr.dimension)
+    goto done_finally;
+
+  gfc_init_block (&block2);
+
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  label_loop = gfc_build_label_decl (NULL_TREE);
+  label_end = gfc_build_label_decl (NULL_TREE);
+  idx = gfc_create_var (TREE_TYPE (rank), "idx");
+  gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+  TREE_USED (label_loop) = 1;
+  tmp = build1_v (LABEL_EXPR, label_loop);
+  gfc_add_expr_to_block (&block2, tmp);
+  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx, rank);
+  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* Loop body.  */
+  /* cfi->dim[i].lower_bound = gfc->dim[i].lbound */
+  gfc_add_modify (&block2, gfc_get_cfi_dim_lbound (cfi, idx),
+		  gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  /* cfi->dim[i].extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1.  */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_ubound_get (gfc_desc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, tmp,
+			 gfc_index_one_node);
+  gfc_add_modify (&block2, gfc_get_cfi_dim_extent (cfi, idx), tmp);
+  /* d->dim[n].sm = gfc->dim[i].stride  * gfc->span); */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc_desc, idx),
+			     gfc_conv_descriptor_span_get (gfc_desc));
+  gfc_add_modify (&block2, gfc_get_cfi_dim_sm (cfi, idx), tmp);
+
+  /* End of loop body.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node, idx,
+			 build_int_cst (signed_char_type_node, 1));
+  gfc_add_modify (&block2, idx, tmp);
+  gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+  TREE_USED (label_end) = 1;
+  tmp = build1_v (LABEL_EXPR, label_end);
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* if (gfc->data != NULL) { block2 }.  */
+  tmp = gfc_get_cfi_desc_base_addr (cfi),
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
+done_finally:
+  /* If optional arg: 'if (arg) { block } else { local_arg = NULL; }'.  */
+  if (sym->attr.optional)
+    {
+      tree present = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, cfi_desc,
+				      null_pointer_node);
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (finally, tmp);
+     }
+   else
+     gfc_add_block_to_block (finally, &block);
+}
 
 /* Generate code for a function.  */
 
@@ -6790,7 +7068,7 @@  gfc_generate_function_code (gfc_namespace * ns)
   tree decl;
   tree tmp;
   tree fpstate = NULL_TREE;
-  stmtblock_t init, cleanup;
+  stmtblock_t init, cleanup, outer_block;
   stmtblock_t body;
   gfc_wrapped_block try_block;
   tree recurcheckvar = NULL_TREE;
@@ -6824,6 +7102,8 @@  gfc_generate_function_code (gfc_namespace * ns)
   trans_function_start (sym);
 
   gfc_init_block (&init);
+  gfc_init_block (&cleanup);
+  gfc_init_block (&outer_block);
 
   if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
     {
@@ -6847,6 +7127,75 @@  gfc_generate_function_code (gfc_namespace * ns)
 	|| ns->parent == NULL)
     parent_fake_result_decl = NULL_TREE;
 
+  /* For BIND(C):
+     - deallocate intent-out allocatable dummy arguments.
+     - Create GFC variable which will later be populated by convert_CFI_desc  */
+  if (sym->attr.is_bind_c)
+    for (gfc_formal_arglist *formal = gfc_sym_get_dummy_args (sym);
+	 formal; formal = formal->next)
+      {
+	gfc_symbol *fsym = formal->sym;
+	if (!is_CFI_desc (fsym, NULL))
+	  continue;
+	if (!fsym->attr.referenced)
+	  {
+	    gfc_conv_cfi_to_gfc (&init, &cleanup, fsym->backend_decl,
+				 NULL_TREE, fsym);
+	    continue;
+	  }
+	/* Let's now create a local GFI descriptor. Afterwards:
+	   desc is the local descriptor,
+	   desc_p is a pointer to it
+	     and stored in sym->backend_decl
+	   GFC_DECL_SAVED_DESCRIPTOR (desc_p) contains the CFI descriptor
+	     -> PARM_DECL and before sym->backend_decl.
+	   For scalars, decl == decl_p is a pointer variable.  */
+	tree desc_p, desc;
+	location_t loc = gfc_get_location (&sym->declared_at);
+	if (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->length)
+	  fsym->ts.u.cl->backend_decl = gfc_create_var (gfc_array_index_type,
+							fsym->name);
+	else if (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->backend_decl)
+	  {
+	    gfc_se se;
+	    gfc_init_se (&se, NULL );
+	    gfc_conv_expr (&se, fsym->ts.u.cl->length);
+	    gfc_add_block_to_block (&init, &se.pre);
+	    fsym->ts.u.cl->backend_decl = se.expr;
+	    gcc_assert(se.post.head == NULL_TREE);
+	  }
+	/* Nullify, otherwise gfc_sym_type will return the CFI type.  */
+	tree tmp = fsym->backend_decl;
+	fsym->backend_decl = NULL;
+	tree type = gfc_sym_type (fsym);
+	gcc_assert (POINTER_TYPE_P (type));
+	if (POINTER_TYPE_P (TREE_TYPE (type)))
+	  /* For instance, allocatable scalars.  */
+	  type = TREE_TYPE (type);
+	if (TREE_CODE (type) == REFERENCE_TYPE)
+	  type = build_pointer_type (TREE_TYPE (type));
+	desc_p = build_decl (loc, VAR_DECL, get_identifier (fsym->name), type);
+	if (!fsym->attr.dimension)
+	  desc = desc_p;
+	else
+	  {
+	    tree size = size_in_bytes (TREE_TYPE (TREE_TYPE (desc_p)));
+	    tree call = builtin_decl_explicit (BUILT_IN_ALLOCA);
+	    call = build_call_expr_loc (input_location, call, 1, size);
+	    gfc_add_modify (&outer_block, desc_p,
+			    fold_convert (TREE_TYPE(desc_p), call));
+	    desc = build_fold_indirect_ref_loc (input_location, desc_p);
+	  }
+	pushdecl (desc_p);
+	if (fsym->attr.optional)
+	  {
+	    gfc_allocate_lang_decl (desc_p);
+	    GFC_DECL_OPTIONAL_ARGUMENT (desc_p) = 1;
+	  }
+	fsym->backend_decl = desc_p;
+	gfc_conv_cfi_to_gfc (&init, &cleanup, tmp, desc, fsym);
+      }
+
   gfc_generate_contained_functions (ns);
 
   has_coarray_vars = false;
@@ -7002,8 +7351,6 @@  gfc_generate_function_code (gfc_namespace * ns)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
-  gfc_init_block (&cleanup);
-
   /* Reset recursion-check variable.  */
   if (recurcheckvar != NULL_TREE)
     {
@@ -7017,8 +7364,8 @@  gfc_generate_function_code (gfc_namespace * ns)
 
   /* Finish the function body and add init and cleanup code.  */
   tmp = gfc_finish_block (&body);
-  gfc_start_wrapped_block (&try_block, tmp);
   /* Add code to create and cleanup arrays.  */
+  gfc_start_wrapped_block (&try_block, tmp);
   gfc_trans_deferred_vars (sym, &try_block);
   gfc_add_init_cleanup (&try_block, gfc_finish_block (&init),
 			gfc_finish_block (&cleanup));
@@ -7036,7 +7383,8 @@  gfc_generate_function_code (gfc_namespace * ns)
     }
   saved_function_decls = NULL_TREE;
 
-  DECL_SAVED_TREE (fndecl) = gfc_finish_wrapped_block (&try_block);
+  gfc_add_expr_to_block (&outer_block, gfc_finish_wrapped_block (&try_block));
+  DECL_SAVED_TREE (fndecl) = gfc_finish_block (&outer_block);
   decl = getdecls ();
 
   /* Finish off this function and send it for code generation.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c4291cce079..b61d131310d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2864,6 +2864,9 @@  tree
 gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p,
 			   bool is_classarray)
 {
+  if (is_CFI_desc (sym, NULL))
+    return build_fold_indirect_ref_loc (input_location, var);
+
   /* Characters are entirely different from other types, they are treated
      separately.  */
   if (sym->ts.type == BT_CHARACTER)
@@ -5481,168 +5484,463 @@  set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
 static void
 gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 {
-  tree tmp;
-  tree cfi_desc_ptr;
-  tree gfc_desc_ptr;
-  tree type;
-  tree cond;
-  tree desc_attr;
-  int attribute;
-  int cfi_attribute;
-  symbol_attribute attr = gfc_expr_attr (e);
+  stmtblock_t block, block2;
+  tree cfi, gfc, gfc_strlen, tmp, tmp2;
+  tree present = NULL;
+  tree rank;
+  gfc_se se;
+
+  if (fsym->attr.optional
+      && e->expr_type == EXPR_VARIABLE
+      && e->symtree->n.sym->attr.optional)
+    present = gfc_conv_expr_present (e->symtree->n.sym);
 
-  /* If this is a full array or a scalar, the allocatable and pointer
-     attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
-  attribute = 2;
-  if (!e->rank || gfc_get_full_arrayspec_from_expr (e))
+  gfc_init_block (&block);
+
+  /* Convert original argument to a tree. */
+  gfc_init_se (&se, NULL);
+  if (e->rank == 0)
     {
-      if (attr.pointer)
-	attribute = 0;
-      else if (attr.allocatable)
-	attribute = 1;
+      gfc_conv_expr (&se, e);
+      gfc = se.expr;
+      if (!POINTER_TYPE_P (TREE_TYPE (gfc)))
+	gfc = gfc_build_addr_expr (NULL_TREE, gfc);
     }
-
-  if (fsym->attr.pointer)
-    cfi_attribute = 0;
-  else if (fsym->attr.allocatable)
-    cfi_attribute = 1;
   else
-    cfi_attribute = 2;
-
-  if (e->rank != 0)
     {
-      parmse->force_no_tmp = 1;
+      se.force_no_tmp = 1;
       if (fsym->attr.contiguous
 	  && !gfc_is_simply_contiguous (e, false, true))
-	gfc_conv_subref_array_arg (parmse, e, false, fsym->attr.intent,
+	gfc_conv_subref_array_arg (&se, e, false, fsym->attr.intent,
 				   fsym->attr.pointer);
       else
-	gfc_conv_expr_descriptor (parmse, e);
-
-      if (POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
-	parmse->expr = build_fold_indirect_ref_loc (input_location,
-						    parmse->expr);
-      bool is_artificial = (INDIRECT_REF_P (parmse->expr)
-			    ? DECL_ARTIFICIAL (TREE_OPERAND (parmse->expr, 0))
-			    : DECL_ARTIFICIAL (parmse->expr));
-
-      /* Unallocated allocatable arrays and unassociated pointer arrays
-	 need their dtype setting if they are argument associated with
-	 assumed rank dummies.  */
-      if (fsym && fsym->as
-	  && (gfc_expr_attr (e).pointer
-	      || gfc_expr_attr (e).allocatable))
-	set_dtype_for_unallocated (parmse, e);
-
-      /* All the temporary descriptors are marked as DECL_ARTIFICIAL. If
-	 the expression type is different from the descriptor type, then
-	 the offset must be found (eg. to a component ref or substring)
-	 and the dtype updated.  Assumed type entities are only allowed
-	 to be dummies in Fortran. They therefore lack the decl specific
-	 appendiges and so must be treated differently from other fortran
-	 entities passed to CFI descriptors in the interface decl.  */
-      type = e->ts.type != BT_ASSUMED ? gfc_typenode_for_spec (&e->ts) :
-					NULL_TREE;
-
-      if (type && is_artificial
-	  && type != gfc_get_element_type (TREE_TYPE (parmse->expr)))
-	{
-	  /* Obtain the offset to the data.  */
-	  gfc_get_dataptr_offset (&parmse->pre, parmse->expr, parmse->expr,
-				  gfc_index_zero_node, true, e);
-
-	  /* Update the dtype.  */
-	  gfc_add_modify (&parmse->pre,
-			  gfc_conv_descriptor_dtype (parmse->expr),
-			  gfc_get_dtype_rank_type (e->rank, type));
-	}
-      else if (type == NULL_TREE
-	       || (!is_subref_array (e) && !is_artificial))
-	{
-	  /* Make sure that the span is set for expressions where it
-	     might not have been done already.  */
-	  tmp = gfc_conv_descriptor_elem_len (parmse->expr);
-	  tmp = fold_convert (gfc_array_index_type, tmp);
-	  gfc_conv_descriptor_span_set (&parmse->pre, parmse->expr, tmp);
-	}
+	gfc_conv_expr_descriptor (&se, e);
+      gfc = se.expr;
+      /* For dt(:)%var the elem_len*stride != sm, hence, GFC uses
+	 elem_len = sizeof(dt) and base_addr = dt(lb) instead.
+	 gfc_get_dataptr_offset fixes the base_addr; for elem_len, see below.
+	 While sm is fine as it uses span*stride and not elem_len.  */
+      if (POINTER_TYPE_P (TREE_TYPE (gfc)))
+	gfc = build_fold_indirect_ref_loc (input_location, gfc);
+      else if (is_subref_array (e) && e->ts.type != BT_CHARACTER)
+	 gfc_get_dataptr_offset (&se.pre, gfc, gfc, NULL, true, e);
+    }
+  gfc_strlen = se.string_length;
+  gfc_add_block_to_block (&block, &se.pre);
+
+  /* Create array decriptor and set version, rank, attribute, type. */
+  cfi = gfc_create_var (gfc_get_cfi_type (e->rank < 0
+					  ? GFC_MAX_DIMENSIONS : e->rank,
+					  false), "cfi");
+  /* Convert to CFI_cdesc_t, which has dim[] to avoid TBAA issues,*/
+  if (fsym->attr.dimension && fsym->as->type == AS_ASSUMED_RANK)
+    {
+      tmp = gfc_get_cfi_type (-1, !fsym->attr.pointer && !fsym->attr.target);
+      tmp = build_pointer_type (tmp);
+      parmse->expr = cfi = gfc_build_addr_expr (tmp, cfi);
+      cfi = build_fold_indirect_ref_loc (input_location, cfi);
+    }
+  else
+    parmse->expr = gfc_build_addr_expr (NULL, cfi);
+
+  tmp = gfc_get_cfi_desc_version (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), CFI_VERSION));
+  if (e->rank < 0)
+    rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank (gfc));
+  else
+    rank = build_int_cst (signed_char_type_node, e->rank);
+  tmp = gfc_get_cfi_desc_rank (cfi);
+  gfc_add_modify (&block, tmp, rank);
+  int itype = CFI_type_other;
+  if (e->ts.f90_type == BT_VOID)
+    itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+	     ? CFI_type_cfunptr : CFI_type_cptr);
+  else
+    switch (e->ts.type)
+      {
+	case BT_INTEGER:
+	case BT_LOGICAL:
+	case BT_REAL:
+	case BT_COMPLEX:
+	  itype = CFI_type_from_type_kind (e->ts.type, e->ts.kind);
+	  break;
+	case BT_CHARACTER:
+	  itype = CFI_type_from_type_kind (CFI_type_Character, e->ts.kind);
+	  break;
+	case BT_DERIVED:
+	  itype = CFI_type_struct;
+	  break;
+	case BT_VOID:
+	  itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+		   ? CFI_type_cfunptr : CFI_type_cptr);
+	  break;
+	case BT_ASSUMED:
+	  itype = CFI_type_other;  // FIXME: Or CFI_type_cptr ?
+	  break;
+	case BT_CLASS:
+	case BT_PROCEDURE:
+	case BT_HOLLERITH:
+	case BT_UNION:
+	case BT_BOZ:
+	case BT_UNKNOWN:
+	  // FIXME: Really unreachable? Or reachable for type(*) ? If so, CFI_type_other?
+	  gcc_unreachable ();
+      }
+
+  tmp = gfc_get_cfi_desc_type (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), itype));
+
+  int attr = CFI_attribute_other;
+  if (fsym->attr.pointer)
+    attr = CFI_attribute_pointer;
+  else if (fsym->attr.allocatable)
+    attr = CFI_attribute_allocatable;
+  tmp = gfc_get_cfi_desc_attribute (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), attr));
+
+  if (e->rank == 0)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), gfc));
     }
   else
     {
-      gfc_conv_expr (parmse, e);
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tmp2 = gfc_conv_descriptor_data_get (gfc);
+      gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
+    }
 
-      if (POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
-	parmse->expr = build_fold_indirect_ref_loc (input_location,
-						    parmse->expr);
+  /* Set elem_len if known - must be before the next if block.
+     Note that allocatable implies 'len=:'.  */
+  if (e->ts.type != BT_ASSUMED && e->ts.type != BT_CHARACTER )
+    {
+      /* Length is known at compile time; use use 'block' for it.  */
+      tmp = size_in_bytes (gfc_typenode_for_spec (&e->ts));
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
 
-      parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
-						    parmse->expr, attr);
+  /* When allocatable + intent out, free the cfi descriptor.  */
+  if (fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tree call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, tmp);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      gfc_add_modify (&block, tmp,
+		      fold_convert (TREE_TYPE (tmp), null_pointer_node));
+      goto done;
     }
 
-  /* Set the CFI attribute field through a temporary value for the
-     gfc attribute.  */
-  desc_attr = gfc_conv_descriptor_attribute (parmse->expr);
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-			 void_type_node, desc_attr,
-			 build_int_cst (TREE_TYPE (desc_attr), cfi_attribute));
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+  /* If not unallocated/unassociated. */
+  gfc_init_block (&block2);
 
-  /* Now pass the gfc_descriptor by reference.  */
-  parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+  /* Set elem_len, which may be only known at run time. */
+  if (e->ts.type == BT_CHARACTER)
+    {
+      gcc_assert (gfc_strlen);
+      tmp = gfc_strlen;
+      if (e->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, MULT_EXPR,
+			       gfc_charlen_type_node, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      e->ts.kind));
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
+  else if (e->ts.type == BT_ASSUMED)
+    {
+      tmp = gfc_conv_descriptor_elem_len (gfc);
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
 
-  /* Variables to point to the gfc and CFI descriptors; cfi = NULL implies
-     that the CFI descriptor is allocated by the gfor_fndecl_gfc_to_cfi call.  */
-  gfc_desc_ptr = parmse->expr;
-  cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
-  gfc_add_modify (&parmse->pre, cfi_desc_ptr, null_pointer_node);
+  if (e->ts.type == BT_ASSUMED)
+    {
+      /* Note: type(*) implies assumed-shape/assumed-rank if fsym requires
+	 an CFI descriptor.  Use the type in the descritor as it provide
+	 mode information. (Quality of implementation feature.)  */
+      tree cond;
+      tree ctype = gfc_get_cfi_desc_type (cfi);
+      tree type = fold_convert (TREE_TYPE (ctype),
+				gfc_conv_descriptor_type (gfc));
+      tree kind = fold_convert (TREE_TYPE (ctype),
+				gfc_conv_descriptor_elem_len (gfc));
+      kind = fold_build2_loc (input_location, LSHIFT_EXPR, TREE_TYPE (type),
+			      kind, build_int_cst (TREE_TYPE (type),
+						   CFI_type_kind_shift));
+
+      /* if (BT_VOID) CFI_type_cptr else CFI_type_other  */
+      /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_VOID));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ctype,
+			     build_int_cst (TREE_TYPE (type), CFI_type_cptr));
+      tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			      ctype,
+			      build_int_cst (TREE_TYPE (type), CFI_type_other));
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_DERIVED) CFI_type_struct else  < tmp2 >  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_DERIVED));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ctype,
+			     build_int_cst (TREE_TYPE (type), CFI_type_struct));
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_CHARACTER) CFI_type_struct + kind=1 else  < tmp2 >  */
+      /* Note: could also be kind=4, with cfi->elem_len = gfc->elem_len/4.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+      tmp = build_int_cst (TREE_TYPE (type),
+			   CFI_type_from_type_kind (CFI_type_Character, 1));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_COMPLEX) CFI_type_Character + kind/2 else  < tmp2 >  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, TREE_TYPE (type),
+			     kind, build_int_cst (TREE_TYPE (type), 2));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (type), tmp,
+			     build_int_cst (TREE_TYPE (type),
+					    CFI_type_Complex));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_INTEGER || BT_LOGICAL || BT_REAL) type + kind else  <tmp2>  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_INTEGER));
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_LOGICAL));
+      cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+			      cond, tmp);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_REAL));
+      cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+			      cond, tmp);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (type),
+			     type, kind);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      gfc_add_expr_to_block (&block2, tmp2);
+    }
 
-  /* Allocate the CFI descriptor itself and fill the fields.  */
-  tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
-  tmp = build_call_expr_loc (input_location,
-			     gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+  if (e->rank != 0)
+    {
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree label_loop = gfc_build_label_decl (NULL_TREE);
+      tree label_end = gfc_build_label_decl (NULL_TREE);
+      tree idx = gfc_create_var (signed_char_type_node, "idx");
+      gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+      TREE_USED (label_loop) = 1;
+      tmp = build1_v (LABEL_EXPR, label_loop);
+      gfc_add_expr_to_block (&block2, tmp);
+      tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx,
+			     rank);
+      tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
 
-  /* Now set the gfc descriptor attribute.  */
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-			 void_type_node, desc_attr,
-			 build_int_cst (TREE_TYPE (desc_attr), attribute));
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+      /* Loop body.  */
+      /* cfi->dim[i].lower_bound = (allocatable/pointer)
+				   ? gfc->dim[i].lbound : 0 */
+      if (fsym->attr.pointer || fsym->attr.allocatable)
+	tmp = gfc_conv_descriptor_lbound_get (gfc, idx);
+      else
+	tmp = gfc_index_zero_node;
+      gfc_add_modify (&block2, gfc_get_cfi_dim_lbound (cfi, idx), tmp);
+      /* cfi->dim[i].extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_ubound_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      gfc_add_modify (&block2, gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      /* d->dim[n].sm = gfc->dim[i].stride  * gfc->span); */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_span_get (gfc));
+      gfc_add_modify (&block2, gfc_get_cfi_dim_sm (cfi, idx), tmp);
 
-  /* The CFI descriptor is passed to the bind_C procedure.  */
-  parmse->expr = cfi_desc_ptr;
+      /* End of loop body.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node,
+			     idx, build_int_cst (signed_char_type_node, 1));
+      gfc_add_modify (&block2, idx, tmp);
+      gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+      TREE_USED (label_end) = 1;
+      tmp = build1_v (LABEL_EXPR, label_end);
+      gfc_add_expr_to_block (&block2, tmp);
 
-  /* Free the CFI descriptor.  */
-  tmp = gfc_call_free (cfi_desc_ptr);
-  gfc_prepend_expr_to_block (&parmse->post, tmp);
+      if (e->expr_type == EXPR_VARIABLE
+	  && e->ref
+	  && e->ref->u.ar.type == AR_FULL
+	  && e->symtree->n.sym->attr.dummy
+	  && e->symtree->n.sym->as
+	  && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
+	{
+	  tmp = gfc_get_cfi_dim_extent (cfi, gfc_rank_cst[e->rank-1]),
+	  gfc_add_modify (&block2, tmp, build_int_cst (TREE_TYPE (tmp), -1));
+	}
+    }
 
-  /* Transfer values back to gfc descriptor.  */
-  if (cfi_attribute != 2  /* CFI_attribute_other.  */
-      && !fsym->attr.value
-      && fsym->attr.intent != INTENT_IN)
+  if (fsym->attr.allocatable || fsym->attr.pointer)
     {
-      tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
-      tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
-      gfc_prepend_expr_to_block (&parmse->post, tmp);
+      tmp = gfc_get_cfi_desc_base_addr (cfi),
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, null_pointer_node);
+      tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
     }
+  else
+    gfc_add_block_to_block (&block, &block2);
 
-  /* Deal with an optional dummy being passed to an optional formal arg
-     by finishing the pre and post blocks and making their execution
-     conditional on the dummy being present.  */
-  if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE
-      && e->symtree->n.sym->attr.optional)
+
+done:
+  if (present)
     {
-      cond = gfc_conv_expr_present (e->symtree->n.sym);
-      tmp = fold_build2 (MODIFY_EXPR, void_type_node,
-			 cfi_desc_ptr,
-			 build_int_cst (pvoid_type_node, 0));
-      tmp = build3_v (COND_EXPR, cond,
-		      gfc_finish_block (&parmse->pre), tmp);
+      parmse->expr = build3_loc (input_location, COND_EXPR,
+				 TREE_TYPE (parmse->expr),
+				 present, parmse->expr, null_pointer_node);
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
+		      build_empty_stmt (input_location));
       gfc_add_expr_to_block (&parmse->pre, tmp);
-      tmp = build3_v (COND_EXPR, cond,
-		      gfc_finish_block (&parmse->post),
+    }
+  else
+    gfc_add_block_to_block (&parmse->pre, &block);
+
+  gfc_init_block (&block);
+
+  if ((!fsym->attr.allocatable && !fsym->attr.pointer)
+      || fsym->attr.intent == INTENT_IN)
+    goto post_call;
+
+  gfc_init_block (&block2);
+  if (e->rank == 0)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+    }
+  else
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_conv_descriptor_data_set (&block, gfc, tmp);
+
+      if (fsym->attr.allocatable)
+	{
+	  /* gfc->span = cfi->elem_len.  */
+	  tmp = fold_convert (gfc_array_index_type,
+			      gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
+	}
+      else
+	{
+	  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+			  ? cfi->dim[0].sm : cfi->elem_len).  */
+	  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+	  tmp2 = fold_convert (gfc_array_index_type,
+			       gfc_get_cfi_desc_elem_len (cfi));
+	  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+				 gfc_array_index_type, tmp, tmp2);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, gfc_index_zero_node);
+	  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+			    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
+	}
+      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
+
+      /* Calculate offset + set lbound, ubound and stride.  */
+      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree label_loop = gfc_build_label_decl (NULL_TREE);
+      tree label_end = gfc_build_label_decl (NULL_TREE);
+      tree idx = gfc_create_var (signed_char_type_node, "idx");
+      gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+      TREE_USED (label_loop) = 1;
+      tmp = build1_v (LABEL_EXPR, label_loop);
+      gfc_add_expr_to_block (&block2, tmp);
+      tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx,
+			     rank);
+      tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
+
+      /* Loop body.  */
+
+      /* gfc->dim[i].lbound = ... */
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&block2, gfc, idx, tmp);
+
+      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc, idx),
+			     gfc_index_one_node);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      gfc_conv_descriptor_ubound_set (&block2, gfc, idx, tmp);
+
+      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+      tmp = gfc_get_cfi_dim_sm (cfi, idx);
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+      gfc_conv_descriptor_stride_set (&block2, gfc, idx, tmp);
+
+      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc), tmp);
+      gfc_conv_descriptor_offset_set (&block2, gfc, tmp);
+
+      /* End of loop body.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node,
+			     idx, build_int_cst (signed_char_type_node, 1));
+      gfc_add_modify (&block2, idx, tmp);
+      gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+      TREE_USED (label_end) = 1;
+      tmp = build1_v (LABEL_EXPR, label_end);
+      gfc_add_expr_to_block (&block2, tmp);
+    }
+
+  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+    {
+      tmp = fold_convert (gfc_charlen_type_node,
+			  gfc_get_cfi_desc_elem_len (cfi));
+      if (e->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_charlen_type_node, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      e->ts.kind));
+      gfc_add_modify (&block2, gfc_strlen, tmp);
+    }
+
+  tmp = gfc_get_cfi_desc_base_addr (cfi),
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
+post_call:
+  gfc_add_block_to_block (&block, &se.post);
+  if (present && block.head)
+    {
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
 		      build_empty_stmt (input_location));
       gfc_add_expr_to_block (&parmse->post, tmp);
     }
+  else if (block.head)
+    gfc_add_block_to_block (&parmse->post, &block);
 }
 
 
@@ -5761,17 +6059,12 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
     {
       bool finalized = false;
-      bool assumed_length_string = false;
       tree derived_array = NULL_TREE;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
-      if (fsym && fsym->ts.type == BT_CHARACTER
-	  && (!fsym->ts.u.cl || !fsym->ts.u.cl->length))
-	assumed_length_string = true;
-
       /* If the procedure requires an explicit interface, the actual
 	 argument is passed according to the corresponding formal
 	 argument.  If the corresponding formal argument is a POINTER,
@@ -6002,9 +6295,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		    parmse.expr = convert (type, tmp);
 		}
 
-	      else if (sym->attr.is_bind_c && e
-		       && (is_CFI_desc (fsym, NULL)
-			   || assumed_length_string))
+	      else if (sym->attr.is_bind_c && e && is_CFI_desc (fsym, NULL))
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
@@ -6214,7 +6505,8 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  if (fsym && fsym->attr.intent == INTENT_OUT
 		      && (fsym->attr.allocatable
 			  || (fsym->ts.type == BT_CLASS
-			      && CLASS_DATA (fsym)->attr.allocatable)))
+			      && CLASS_DATA (fsym)->attr.allocatable))
+		      && !is_CFI_desc (fsym, NULL))
 		    {
 		      stmtblock_t block;
 		      tree ptr;
@@ -6448,8 +6740,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		    parmse.force_tmp = 1;
 		}
 
-	      if (sym->attr.is_bind_c && e
-		  && (is_CFI_desc (fsym, NULL) || assumed_length_string))
+	      if (sym->attr.is_bind_c && e && is_CFI_desc (fsym, NULL))
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
@@ -6536,9 +6827,11 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
-		 allocated on entry, it must be deallocated.  */
+		 allocated on entry, it must be deallocated.
+		 CFI descriptors are handled elsewhere.  */
 	      if (fsym && fsym->attr.allocatable
-		  && fsym->attr.intent == INTENT_OUT)
+		  && fsym->attr.intent == INTENT_OUT
+		  && !is_CFI_desc (fsym, NULL))
 		{
 		  if (fsym->ts.type == BT_DERIVED
 		      && fsym->ts.u.derived->attr.alloc_comp)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 6f9b0e390de..11cacf36371 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -72,7 +72,8 @@  gfc_omp_is_allocatable_or_ptr (const_tree decl)
 static bool
 gfc_omp_is_optional_argument (const_tree decl)
 {
-  return (TREE_CODE (decl) == PARM_DECL
+  /* Note: VAR_DECL can occur with BIND(C) and array descriptors.  */
+  return ((TREE_CODE (decl) == PARM_DECL || TREE_CODE (decl) == VAR_DECL)
 	  && DECL_LANG_SPECIFIC (decl)
 	  && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
 	  && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
@@ -105,8 +106,9 @@  gfc_omp_check_optional_argument (tree decl, bool for_present_check)
 	  || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
     decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
 
+  /* Note: With BIND(C), array descriptors are converted to a VAR_DECL.  */
   if (decl == NULL_TREE
-      || TREE_CODE (decl) != PARM_DECL
+      || (TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != VAR_DECL)
       || !DECL_LANG_SPECIFIC (decl)
       || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
     return NULL_TREE;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 11df1863bad..466109e8af3 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3669,10 +3669,7 @@  gfc_trans_select_rank_cases (gfc_code * code)
   tree tmp;
   tree cond;
   tree low;
-  tree sexpr;
   tree rank;
-  tree rank_minus_one;
-  tree minus_one;
   gfc_se se;
   gfc_se cse;
   stmtblock_t block;
@@ -3686,24 +3683,25 @@  gfc_trans_select_rank_cases (gfc_code * code)
   gfc_conv_expr_descriptor (&se, code->expr1);
   rank = gfc_conv_descriptor_rank (se.expr);
   rank = gfc_evaluate_now (rank, &block);
-  minus_one = build_int_cst (TREE_TYPE (rank), -1);
-  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-			 gfc_array_index_type,
-			 fold_convert (gfc_array_index_type, rank),
-			 build_int_cst (gfc_array_index_type, 1));
-  rank_minus_one = gfc_evaluate_now (tmp, &block);
-  tmp = gfc_conv_descriptor_ubound_get (se.expr, rank_minus_one);
-  cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			  tmp, build_int_cst (TREE_TYPE (tmp), -1));
-  tmp = fold_build3_loc (input_location, COND_EXPR,
-			 TREE_TYPE (rank), cond,
-			 rank, minus_one);
-  cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
-			  rank, build_int_cst (TREE_TYPE (rank), 0));
-  sexpr = fold_build3_loc (input_location, COND_EXPR,
-			   TREE_TYPE (rank), cond,
-			   rank, tmp);
-  sexpr = gfc_evaluate_now (sexpr, &block);
+  symbol_attribute attr = gfc_expr_attr (code->expr1);
+  if (!attr.pointer || !attr.allocatable)
+    {
+      /* Special case for assumed-rank ('rank(*)', internally -1):
+	 rank = (rank == 0 || ubound[rank-1] != -1) ? rank : -1.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			      rank, build_int_cst (TREE_TYPE (rank), 0));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     fold_convert (gfc_array_index_type, rank),
+			     gfc_index_one_node);
+      tmp = gfc_conv_descriptor_ubound_get (se.expr, tmp);
+      tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+			     tmp, build_int_cst (TREE_TYPE (tmp), -1));
+      cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+			      logical_type_node, cond, tmp);
+      tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (rank),
+			     cond, rank, build_int_cst (TREE_TYPE (rank), -1));
+      rank = gfc_evaluate_now (tmp, &block);
+    }
   TREE_USED (code->exit_label) = 0;
 
 repeat:
@@ -3747,8 +3745,8 @@  repeat:
       if (low != NULL_TREE)
 	{
 	  cond = fold_build2_loc (input_location, EQ_EXPR,
-				  TREE_TYPE (sexpr), sexpr,
-				  fold_convert (TREE_TYPE (sexpr), low));
+				  TREE_TYPE (rank), rank,
+				  fold_convert (TREE_TYPE (rank), low));
 	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 				 cond, tmp,
 				 build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1c78a906397..46af382a64c 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -77,6 +77,7 @@  static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
 static GTY(()) tree gfc_array_descriptor_base[2 * (GFC_MAX_DIMENSIONS+1)];
 static GTY(()) tree gfc_array_descriptor_base_caf[2 * (GFC_MAX_DIMENSIONS+1)];
+static GTY(()) tree gfc_cfi_descriptor_base[2 * (CFI_MAX_RANK + 2)];
 
 /* Arrays for all integral and real kinds.  We'll fill this in at runtime
    after the target has a chance to process command-line options.  */
@@ -1575,8 +1576,9 @@  gfc_get_dtype_rank_type (int rank, tree etype)
 
   field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
 			     GFC_DTYPE_RANK);
-  CONSTRUCTOR_APPEND_ELT (v, field,
-			  build_int_cst (TREE_TYPE (field), rank));
+  if (rank >= 0)
+    CONSTRUCTOR_APPEND_ELT (v, field,
+			    build_int_cst (TREE_TYPE (field), rank));
 
   field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
 			     GFC_DTYPE_TYPE);
@@ -2244,7 +2246,7 @@  gfc_nonrestricted_type (tree t)
    especially for character and array types.  */
 
 tree
-gfc_sym_type (gfc_symbol * sym)
+gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
 {
   tree type;
   int byref;
@@ -2299,7 +2301,13 @@  gfc_sym_type (gfc_symbol * sym)
   if (!restricted)
     type = gfc_nonrestricted_type (type);
 
-  if (sym->attr.dimension || sym->attr.codimension)
+  /* Dummy argument to a bind(C) procedure.  */
+  /* FIXME: Uses restricted=false to avoid alias issues with
+     descriptor conversion.  */
+  if (is_bind_c && is_CFI_desc (sym, NULL))
+    type = gfc_get_cfi_type (sym->attr.dimension ? sym->as->rank : 0,
+			     /* restricted = */ false);
+  else if (sym->attr.dimension || sym->attr.codimension)
     {
       if (gfc_is_nodesc_array (sym))
         {
@@ -3131,7 +3139,7 @@  gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 	      type = build_pointer_type (type);
 	    }
 	  else
-	    type = gfc_sym_type (arg);
+	    type = gfc_sym_type (arg, sym->attr.is_bind_c);
 
 	  /* Parameter Passing Convention
 
@@ -3722,4 +3730,94 @@  gfc_get_caf_reference_type ()
   return reference_type;
 }
 
+static tree
+gfc_get_cfi_dim_type ()
+{
+  static tree CFI_dim_t = NULL;
+
+  if (CFI_dim_t)
+    return CFI_dim_t;
+
+  CFI_dim_t = make_node (RECORD_TYPE);
+  TYPE_NAME (CFI_dim_t) = get_identifier ("CFI_dim_t");
+  TYPE_NAMELESS (CFI_dim_t) = 1;
+  tree field;
+  tree *chain = NULL;
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("lower_bound"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("extent"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("sm"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  gfc_finish_type (CFI_dim_t);
+  TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (CFI_dim_t)) = 1;
+  return CFI_dim_t;
+}
+
+
+/* Return the CFI type; use dimen == -1 for dim[] (only for pointers);
+   otherwise dim[dimen] is used.  */
+
+tree
+gfc_get_cfi_type (int dimen, bool restricted)
+{
+  gcc_assert (dimen >= -1 && dimen <= CFI_MAX_RANK);
+
+  int idx = 2*(dimen + 1) + restricted;
+
+  if (gfc_cfi_descriptor_base[idx])
+    return gfc_cfi_descriptor_base[idx];
+
+  /* Build the type node.  */
+  tree CFI_cdesc_t = make_node (RECORD_TYPE);
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  if (dimen != -1)
+    sprintf (name, "CFI_cdesc_t" GFC_RANK_PRINTF_FORMAT, dimen);
+  TYPE_NAME (CFI_cdesc_t) = get_identifier (dimen < 0 ? "CFI_cdesc_t" : name);
+  TYPE_NAMELESS (CFI_cdesc_t) = 1;
+
+  tree field;
+  tree *chain = NULL;
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("base_addr"),
+				     (restricted ? prvoid_type_node
+						 : ptr_type_node), &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("elem_len"),
+				     size_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("version"),
+				     integer_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("rank"),
+				     signed_char_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("attribute"),
+				     signed_char_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("type"),
+				     get_typenode_from_name (INT16_TYPE),
+				     &chain);
+  suppress_warning (field);
+
+  if (dimen != 0)
+    {
+      tree range = NULL_TREE;
+      if (dimen > 0)
+	range = gfc_rank_cst[dimen - 1];
+      range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+				range);
+      tree CFI_dim_t = build_array_type (gfc_get_cfi_dim_type (), range);
+      field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("dim"),
+					 CFI_dim_t, &chain);
+      suppress_warning (field);
+    }
+
+  gfc_finish_type (CFI_cdesc_t);
+  gfc_cfi_descriptor_base[idx] = CFI_cdesc_t;
+  return CFI_cdesc_t;
+}
+
 #include "gt-fortran-trans-types.h"
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 3b45ce25666..f8bccec79f8 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -84,7 +84,8 @@  tree gfc_get_character_type (int, gfc_charlen *);
 tree gfc_get_character_type_len (int, tree);
 tree gfc_get_character_type_len_for_eltype (tree, tree);
 
-tree gfc_sym_type (gfc_symbol *);
+tree gfc_sym_type (gfc_symbol *, bool is_bind_c_arg = false);
+tree gfc_get_cfi_type (int dimen, bool restricted);
 tree gfc_typenode_for_spec (gfc_typespec *, int c = 0);
 int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool);
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index eb5682a7cda..22f267645e8 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -608,9 +608,9 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
 
   if (once)
     {
-       tmpvar = gfc_create_var (logical_type_node, "print_warning");
+       tmpvar = gfc_create_var (boolean_type_node, "print_warning");
        TREE_STATIC (tmpvar) = 1;
-       DECL_INITIAL (tmpvar) = logical_true_node;
+       DECL_INITIAL (tmpvar) = boolean_true_node;
        gfc_add_expr_to_block (pblock, tmpvar);
     }
 
@@ -631,7 +631,7 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   va_end (ap);
 
   if (once)
-    gfc_add_modify (&block, tmpvar, logical_false_node);
+    gfc_add_modify (&block, tmpvar, boolean_false_node);
 
   body = gfc_finish_block (&block);
 
@@ -643,9 +643,8 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
     {
       if (once)
 	cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR,
-				long_integer_type_node, tmpvar, cond);
-      else
-	cond = fold_convert (long_integer_type_node, cond);
+				boolean_type_node, tmpvar,
+				fold_convert (boolean_type_node, cond));
 
       tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node,
 			     cond, body,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 78578cfd732..897c5d60b2a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -855,8 +855,6 @@  extern GTY(()) tree gfor_fndecl_ctime;
 extern GTY(()) tree gfor_fndecl_fdate;
 extern GTY(()) tree gfor_fndecl_in_pack;
 extern GTY(()) tree gfor_fndecl_in_unpack;
-extern GTY(()) tree gfor_fndecl_cfi_to_gfc;
-extern GTY(()) tree gfor_fndecl_gfc_to_cfi;
 extern GTY(()) tree gfor_fndecl_associated;
 extern GTY(()) tree gfor_fndecl_system_clock4;
 extern GTY(()) tree gfor_fndecl_system_clock8;
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_19.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_19.f90
new file mode 100644
index 00000000000..0969103e736
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_19.f90
@@ -0,0 +1,27 @@ 
+! This testcase failed before with optimization as
+! allocatef's argument 'x' has is __restrict / has no target attribute
+! but this CFI descriptor does alias with the internally used GFC descriptor
+!
+
+program testit
+  use iso_c_binding
+  implicit none (external, type)
+  type, bind (c) :: m
+    integer(C_INT) :: i, j
+  end type
+  type(m), allocatable :: a(:)
+
+  call testf (a)
+
+contains
+  subroutine allocatef (x) bind (c)
+    type(m), allocatable :: x(:)
+    allocate (x(5:15))
+  end subroutine
+
+  subroutine testf (y)
+    type(m), allocatable, target :: y(:)
+    call allocatef (y)
+    if (.not. allocated (y))  stop 1
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
index 7731d1a6c88..c596e47cfdd 100644
--- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
@@ -19,23 +19,37 @@  contains
 
   subroutine substr(str) BIND(C)
     character(*) :: str(:)
-    if (str(2) .ne. "ghi") stop 2
+    if (str(1) .ne. "bcd") stop 2
+    if (str(2) .ne. "ghi") stop 3
     str = ['uvw','xyz']
   end subroutine
 
+  subroutine substr4(str4) BIND(C)
+    character(*, kind=4) :: str4(:)
+    print *, str4(1)
+    print *, str4(2)
+    if (str4(1) .ne. 4_"bcd") stop 4
+    if (str4(2) .ne. 4_"ghi") stop 5
+    str4 = [4_'uvw', 4_'xyz']
+  end subroutine
+
 end module
 
 program p
   use mod_ctg
   implicit none
   real :: x(6)
-  character(5) :: str(2) = ['abcde','fghij']
+  character(5)         :: str(2)  = ['abcde', 'fghij']
+  character(5, kind=4) :: str4(2) = [4_'abcde', 4_'fghij']
   integer :: i
 
   x = [ (real(i), i=1, size(x)) ]
   call ctg(x(2::2))
   if (any (abs (x - [1.,20.,3.,40.,5.,60.]) > 1.e-6)) stop 3
 
-  call substr(str(:)(2:4))
-  if (any (str .ne. ['auvwe','fxyzj'])) stop 4
+  !call substr(str(:)(2:4))
+  !if (any (str .ne. ['auvwe','fxyzj'])) stop 4
+
+  call substr4(str4(:)(2:4))
+  if (any (str4 .ne. [4_'auvwe', 4_'fxyzj'])) stop 4
 end program
diff --git a/gcc/testsuite/gfortran.dg/PR100915.c b/gcc/testsuite/gfortran.dg/PR100915.c
index 5b219b37187..4eaf82a5d27 100644
--- a/gcc/testsuite/gfortran.dg/PR100915.c
+++ b/gcc/testsuite/gfortran.dg/PR100915.c
@@ -67,7 +67,7 @@  check_fn (const CFI_cdesc_t *restrict auxp, const CFI_type_t type, const signed
   /*  */
   assert (auxp->type==type);
   ityp = _CFI_decode_type(auxp->type);
-  assert (ityp == CFI_type_cptr);
+  assert (ityp == CFI_type_cfunptr);
   iknd = _CFI_decode_kind(auxp->type);
   assert (_CFI_decode_type(type)==ityp);
   assert (kind==iknd);
diff --git a/gcc/testsuite/gfortran.dg/PR100915.f90 b/gcc/testsuite/gfortran.dg/PR100915.f90
index 083565e5ddf..64a2a88fe2d 100644
--- a/gcc/testsuite/gfortran.dg/PR100915.f90
+++ b/gcc/testsuite/gfortran.dg/PR100915.f90
@@ -14,7 +14,7 @@  module isof_m
   private
   
   public :: &
-    CFI_type_cptr
+    CFI_type_cptr, CFI_type_cfunptr
   
   public ::      &
     check_fn_as, &
@@ -33,6 +33,7 @@  module isof_m
 
   ! Intrinsic types. Their kind number defines their storage size. */
   integer(kind=c_signed_char), parameter :: CFI_type_cptr   = 7
+  integer(kind=c_signed_char), parameter :: CFI_type_cfunptr   = 8
 
   interface
     subroutine check_fn_as(a, t, k, e, n) &
@@ -99,7 +100,7 @@  module iso_check_m
     c_funptr, c_funloc, c_associated
 
   use :: isof_m, only:  &
-    CFI_type_cptr
+    CFI_type_cptr, CFI_type_cfunptr
   
   use :: isof_m, only: &
     check_fn_as,       &
@@ -155,7 +156,7 @@  contains
     !
     k = 0
     e = storage_size(a)/b
-    t = cfi_encode_type(CFI_type_cptr, k)
+    t = cfi_encode_type(CFI_type_cfunptr, k)
     ! Assumes 64-bit target.
     ! if(e/=8) stop 5
     do i = 1, n
@@ -176,7 +177,7 @@  contains
     !
     k = 0
     e = storage_size(a)/b
-    t = cfi_encode_type(CFI_type_cptr, k)
+    t = cfi_encode_type(CFI_type_cfunptr, k)
     ! Assumes 64-bit target.
     ! if(e/=8) stop 8
     do i = 1, n
@@ -198,7 +199,7 @@  contains
     !
     k = 0
     e = storage_size(a)/b
-    t = cfi_encode_type(CFI_type_cptr, k)
+    t = cfi_encode_type(CFI_type_cfunptr, k)
     ! Assumes 64-bit target.
     ! if(e/=8) stop 11
     select rank(a)
@@ -229,7 +230,7 @@  contains
     !
     k = 0
     e = storage_size(a)/b
-    t = cfi_encode_type(CFI_type_cptr, k)
+    t = cfi_encode_type(CFI_type_cfunptr, k)
     ! Assumes 64-bit target.
     ! if(e/=8) stop 16
     select rank(a)
diff --git a/gcc/testsuite/gfortran.dg/PR93963.f90 b/gcc/testsuite/gfortran.dg/PR93963.f90
index 4e1b06fd525..66c937974ac 100644
--- a/gcc/testsuite/gfortran.dg/PR93963.f90
+++ b/gcc/testsuite/gfortran.dg/PR93963.f90
@@ -3,6 +3,8 @@ 
 ! Test the fix for PR93963
 !
 
+module m
+contains
 function rank_p(this) result(rnk) bind(c)
   use, intrinsic :: iso_c_binding, only: c_int
 
@@ -97,27 +99,60 @@  function rank_a(this) result(rnk) bind(c)
   return
 end function rank_a
 
-program selr_p
-
+function rank_o(this) result(rnk) bind(c)
   use, intrinsic :: iso_c_binding, only: c_int
 
   implicit none
+  
+  integer(kind=c_int), intent(in) :: this(..)
+  integer(kind=c_int)             :: rnk
 
-  interface
-    function rank_p(this) result(rnk) bind(c)
-      use, intrinsic :: iso_c_binding, only: c_int
-      integer(kind=c_int), pointer, intent(in) :: this(..)
-      integer(kind=c_int)                      :: rnk
-    end function rank_p
-  end interface
-
-  interface
-    function rank_a(this) result(rnk) bind(c)
-      use, intrinsic :: iso_c_binding, only: c_int
-      integer(kind=c_int), allocatable, intent(in) :: this(..)
-      integer(kind=c_int)                          :: rnk
-    end function rank_a
-  end interface
+  select rank(this)
+  rank(0)
+    rnk = 0
+  rank(1)
+    rnk = 1
+  rank(2)
+    rnk = 2
+  rank(3)
+    rnk = 3
+  rank(4)
+    rnk = 4
+  rank(5)
+    rnk = 5
+  rank(6)
+    rnk = 6
+  rank(7)
+    rnk = 7
+  rank(8)
+    rnk = 8
+  rank(9)
+    rnk = 9
+  rank(10)
+    rnk = 10
+  rank(11)
+    rnk = 11
+  rank(12)
+    rnk = 12
+  rank(13)
+    rnk = 13
+  rank(14)
+    rnk = 14
+  rank(15)
+    rnk = 15
+  rank default
+    rnk = -1000
+  end select
+  return
+end function rank_o
+
+end module m
+
+program selr_p
+  use m
+  use, intrinsic :: iso_c_binding, only: c_int
+
+  implicit none
 
   integer(kind=c_int), parameter :: siz = 7
   integer(kind=c_int), parameter :: rnk = 1
@@ -139,12 +174,19 @@  program selr_p
   irnk = rank_p(intp)
   if (irnk /= rnk)        stop 5
   if (irnk /= rank(intp)) stop 6
+  irnk = rank_o(intp)
+  if (irnk /= rnk)        stop 7
+  if (irnk /= rank(intp)) stop 8
   deallocate(intp)
   nullify(intp)
   !
   allocate(inta(siz))
-  if (irnk /= rnk)        stop 7
-  if (irnk /= rank(inta)) stop 8
+  irnk = rank_a(inta)
+  if (irnk /= rnk)        stop 9
+  if (irnk /= rank(inta)) stop 10
+  irnk = rank_o(inta)
+  if (irnk /= rnk)        stop 11
+  if (irnk /= rank(inta)) stop 12
   deallocate(inta)
 
 end program selr_p
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_12.f90 b/gcc/testsuite/gfortran.dg/assumed_type_12.f90
new file mode 100644
index 00000000000..852fd41445d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_12.f90
@@ -0,0 +1,35 @@ 
+! PR fortran/102086
+
+implicit none (type, external)
+contains
+subroutine as(a)
+  type(*) :: a(:,:)
+end
+subroutine ar(b)
+  type(*) :: b(..)
+end
+subroutine bar(x,y)
+  type(*) :: x
+  type(*) :: y(3,*)
+  call as(x)  ! { dg-error "Rank mismatch in argument 'a' at .1. \\(rank-2 and scalar\\)" }
+  call ar(x)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'b' has assumed rank" }
+  call as(y)  ! { dg-error "Actual argument for 'a' cannot be an assumed-size array" }
+  call ar(y)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'b' has assumed rank" }
+  call as(y(1,3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call ar(y(1,3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call as(y(1:1,3:3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call ar(y(1:1,3:3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+end
+
+subroutine okayish(x,y,z)
+  type(*) :: x(:)
+  type(*) :: y(:,:)
+  type(*) :: z(..)
+  call as(x) ! { dg-error "Rank mismatch in argument 'a' at .1. \\(rank-2 and rank-1\\)" }
+  call as(y) 
+  call as(z) ! { dg-error "The assumed-rank array at .1. requires that the dummy argument 'a' has assumed-rank" }
+  call ar(x)
+  call ar(y)
+  call ar(z)
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90
new file mode 100644
index 00000000000..b8d90a4c4c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90
@@ -0,0 +1,82 @@ 
+! PR fortran/92482
+!
+! Contirbuted by  José Rui Faustino de Sousa 
+!
+! Note the xfail issue below for 'strg_print_2("abc")
+
+program strp_p
+
+  use, intrinsic :: iso_c_binding, only: &
+    c_char
+    
+  implicit none
+
+  integer, parameter :: l = 3
+
+  character(len=l, kind=c_char),  target :: str
+  character(len=:, kind=c_char), pointer :: strp_1
+  character(len=l, kind=c_char), pointer :: strp_2
+
+  str = "abc"
+  nullify(strp_1, strp_2)
+  strp_1 => str
+  strp_2 => str
+  if (len(str) /= 3 .or. str /= "abc") stop 1
+  if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2
+  if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3
+  call strg_print_0("abc") ! Error (10.0.0) or segmentation fault (9.1.0)
+  call strg_print_0(str) ! Error (10.0.0) or segmentation fault (9.1.0)
+  call strg_print_0(strp_1) ! Error (10.0.0) or segmentation fault (9.1.0)
+  call strg_print_0(strp_2) ! Error (10.0.0) or segmentation fault (9.1.0)
+  call strg_print_1(strp_1) ! Not yet supported
+  call strg_print_2("abc", .true.)
+  call strg_print_2(str)
+  call strg_print_2(strp_1)
+  call strg_print_2(strp_2)
+
+contains
+
+  subroutine strg_print_0(this) bind(c) ! Error (10.0.0 20191106) or warning (9.1.0) issued with bind(c)
+    character(len=*, kind=c_char), target, intent(in) :: this
+
+    if (len (this) /= 3) stop 10
+    if (this /= "abc") stop 11
+  end subroutine strg_print_0
+  
+  subroutine strg_print_1(this) bind(c) ! Not yet supported with bind(c)
+    character(len=:, kind=c_char), pointer, intent(in) :: this
+    character(len=:), pointer :: strn
+
+    if (.not. associated (strn)) stop 20
+    if (len (this) /= 3) stop 21
+    if (this /= "abc") stop 22
+     strn => this
+     if (.not. associated (strn)) stop 23
+     if(associated(strn))then
+       if (len (this) /= 3) stop 24
+       if (this /= "abc") stop 25
+     end if
+   end subroutine strg_print_1
+  
+  subroutine strg_print_2(this, xfail) ! bind(c) ! <- works OK with bind(c)
+    use, intrinsic :: iso_c_binding, only: &
+      c_loc, c_f_pointer
+    
+    type(*), target, intent(in) :: this(..)
+    logical, optional, value :: xfail
+    character(len=l), pointer :: strn
+
+    call c_f_pointer(c_loc(this), strn)
+    if (.not. associated (strn)) stop 30
+    if(associated(strn))then
+      if (len (strn) /= 3) stop 31
+      if (strn /= "abc") then
+        if (present (xfail)) then
+          print *, 'INVALID STRING - EXPECTED "abc" / PR47225'
+        else
+          stop 32
+        end if
+      end if
+    end if
+  end subroutine strg_print_2
+end program strp_p
diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
index 39822c0753a..d416fa5ea94 100644
--- a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
@@ -1,4 +1,4 @@ 
-! { dg-do compile }
+! { dg-do run }
 ! { dg-options "-fdump-tree-original" }
 !
 ! PR fortran/91863
@@ -28,15 +28,20 @@  program p
   if (.not.allocated(a)) stop 1
   if (any(shape(a) /= [3])) stop 2
   if (lbound(a,1) /= 3 .or. ubound(a,1) /= 5) stop 3
+  print *, a(0), a(1), a(2), a(3), a(4)
+  print *, a
   if (any(a /= [1, 2, 3])) stop 4
 end program p
 
 ! "cfi" only appears in context of "a" -> bind-C descriptor
-! the intent(out) implies freeing in the callee (!), hence the "free"
+! the intent(out) implies freeing in the callee (!) (when implemented in Fortran), hence the "free"
+! and also in the caller (when implemented in Fortran)
 ! It is the only 'free' as 'a' is part of the main program and, hence, implicitly has the SAVE attribute.
 ! The  'cfi = 0' appears before the call due to the deallocate and when preparing the C descriptor
 ! As cfi (i.e. the descriptor itself) is allocated in libgomp, it has to be freed after the call.
 
 ! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 2 "original" } }
-! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+ = 0B;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(_x->base_addr\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_x->base_addr = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\.base_addr\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+\\.base_addr = 0B;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
index ede6eff67fa..688fb972527 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
@@ -22,4 +22,32 @@  end
 ! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } }
 ! { dg-final { scan-assembler-times "bl \.myBindC" 1 { target { powerpc-ibm-aix* } } } }
 ! { dg-final { scan-assembler-times "add_u32\t\[sv\]\[0-9\]*, \[sv\]\[0-9\]*, myBindC@rel32@lo" 1 { target { amdgcn*-*-* } } } }
-! { dg-final { scan-tree-dump-times "gfc_desc_to_cfi_desc \\\(&cfi\\." 1 "original" } }
+
+
+! { dg-final { scan-tree-dump "parm...span = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dtype = {.elem_len=4, .rank=2, .type=1};" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].lbound = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].ubound = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].stride = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].lbound = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].ubound = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].stride = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...data = \\(void \\*\\) &aa\\\[0\\\];" "original" } }
+! { dg-final { scan-tree-dump "parm...offset = -5;" "original" } }
+! { dg-final { scan-tree-dump "cfi...version = 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...rank = 2;" "original" } }
+! { dg-final { scan-tree-dump "cfi...type = 1025;" "original" } }
+! { dg-final { scan-tree-dump "cfi...attribute = 2;" "original" } }
+! { dg-final { scan-tree-dump "cfi...base_addr = parm.0.data;" "original" } }
+! { dg-final { scan-tree-dump "cfi...elem_len = 4;" "original" } }
+! { dg-final { scan-tree-dump "idx.2 = 0;" "original" } }
+
+! { dg-final { scan-tree-dump "if \\(idx.. > 1\\) goto L..;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].lower_bound = 0;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].extent = \\(parm...dim\\\[idx..\\\].ubound - parm...dim\\\[idx..\\\].lbound\\) \\+ 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].sm = parm...dim\\\[idx..\\\].stride \\* parm...span;" "original" } }
+! { dg-final { scan-tree-dump "idx.. = idx.. \\+ 1;" "original" } }
+
+! { dg-final { scan-tree-dump "test \\(&cfi..\\);" "original" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
index 35958515d38..7c6f4dcc961 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
@@ -466,15 +466,16 @@  program main
 end
 
 ! All arguments shall use array descriptors
-! { dg-final { scan-tree-dump-times "void as1 \\(struct array01_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as2 \\(struct array01_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as4 \\(struct array01_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as3 \\(struct array01_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
-! { dg-final { scan-tree-dump-times "void ar1 \\(struct array15_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ar2 \\(struct array15_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ar3 \\(struct array15_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
-! { dg-final { scan-tree-dump-times "void ar4 \\(struct array15_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5a \\(struct array01_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5ar \\(struct array15_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5p \\(struct array01_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5pr \\(struct array15_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as1 \\(struct CFI_cdesc_t01 & restrict _x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as2 \\(struct CFI_cdesc_t01 & restrict _x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as3 \\(struct CFI_cdesc_t01 & restrict _xn, integer\\(kind=4\\) & restrict n\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as4 \\(struct CFI_cdesc_t01 & restrict _xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar1 \\(struct CFI_cdesc_t & restrict _x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar2 \\(struct CFI_cdesc_t & restrict _x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar3 \\(struct CFI_cdesc_t & restrict _xn, integer\\(kind=4\\) & restrict n\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar4 \\(struct CFI_cdesc_t & restrict _xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5ar \\(struct CFI_cdesc_t & restrict _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5a \\(struct CFI_cdesc_t01 & restrict _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5pr \\(struct CFI_cdesc_t & _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5p \\(struct CFI_cdesc_t01 & _xcolon\\)" 1 "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
index c6f406f3c5c..8e6413d0bf4 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
@@ -28,7 +28,7 @@  subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1.
   character(len=n) :: xn
 end
 
-subroutine s4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 's4' with BIND\\(C\\) attribute" }
+subroutine s4 (xstar) bind(C)
   character(len=*) :: xstar
 end
 
@@ -85,7 +85,7 @@  subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1
   character(len=n) :: xn(*)
 end
 
-subroutine az4 (xstar) bind(C)  ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'az4' with BIND\\(C\\) attribute" }
+subroutine az4 (xstar) bind(C)
   character(len=*) :: xstar(*)
 end
 
@@ -104,7 +104,7 @@  subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1
   character(len=n) :: xn(9)
 end
 
-subroutine ae4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'ae4' with BIND\\(C\\) attribute" }
+subroutine ae4 (xstar) bind(C)
   character(len=*) :: xstar(3)
 end
 
@@ -128,7 +128,7 @@  subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argumen
   character(len=*), allocatable :: xstar
 end
 
-subroutine s5a (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) not yet supported" }
+subroutine s5a (xcolon) bind(C)
   character(len=:), allocatable :: xcolon
 end
 
@@ -198,7 +198,7 @@  subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'x
   character(len=*), pointer :: xstar
 end
 
-subroutine s5p (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) not yet supported" }
+subroutine s5p (xcolon) bind(C)
   character(len=:), pointer :: xcolon
 end
 
diff --git a/gcc/testsuite/gfortran.dg/c-interop/allocatable-dummy.f90 b/gcc/testsuite/gfortran.dg/c-interop/allocatable-dummy.f90
index 4161a30b16a..1d0cf65ba0c 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/allocatable-dummy.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/allocatable-dummy.f90
@@ -1,6 +1,6 @@ 
 ! PR 101308
 ! PR 92621(?)
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "allocatable-dummy-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c1255-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c1255-1.f90
index 62fee2c4f50..fb91107bd9b 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c1255-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c1255-1.f90
@@ -56,7 +56,7 @@  module m
     end subroutine
 
     ! dummy is assumed length character variable
-    subroutine s6 (x) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine s6 (x) bind (c)
       use ISO_C_BINDING
       implicit none
       character(len=*) :: x
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
index e4da66adade..e2fa1c85b40 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
@@ -44,7 +44,7 @@  subroutine s2 (x)
   implicit none
   type(*) :: x(*)
 
-  call g (x, 1)  ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } }
+  call g (x, 1)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'a' has assumed rank" }
 end subroutine
 
 ! Check that a scalar gives an error.
@@ -53,7 +53,7 @@  subroutine s3 (x)
   implicit none
   type(*) :: x
 
-  call g (x, 1)  ! { dg-error "Assumed.type" "pr101333" { xfail *-*-* } }
+  call g (x, 1)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'a' has assumed rank" }
 end subroutine
 
 ! Explicit-shape assumed-type actual arguments are forbidden implicitly
diff --git a/gcc/testsuite/gfortran.dg/c-interop/cf-descriptor-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/cf-descriptor-5.f90
index f178bb8d733..b5edf528417 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/cf-descriptor-5.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/cf-descriptor-5.f90
@@ -7,7 +7,7 @@ 
 ! in C works and that you can use it to call back into a Fortran function 
 ! with an assumed-length dummy that is declared with C binding.
 
-subroutine ftest (a, n) bind (c, name="ftest")  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+subroutine ftest (a, n) bind (c, name="ftest")
   use iso_c_binding
   character(kind=C_CHAR, len=*) :: a
   integer(C_INT), value :: n
diff --git a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-3.f90
index 5e5f5955973..d85a78a8a6c 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-3.f90
@@ -1,5 +1,5 @@ 
 ! PR 92621 (?)
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "cf-out-descriptor-3-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-4.f90 b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-4.f90
index 082610c2da7..e14c7571ea2 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-4.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-4.f90
@@ -1,5 +1,5 @@ 
 ! PR 92621 (?)
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "cf-out-descriptor-4-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-5.f90
index ff1e31d345f..b0dd20ce5f8 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-5.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-5.f90
@@ -6,7 +6,7 @@ 
 ! This program checks use of an assumed-length character dummy argument
 ! as an intent(out) parameter in subroutines with C binding.
 
-subroutine ftest (a, n) bind (c, name="ftest")  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+subroutine ftest (a, n) bind (c, name="ftest")
   use iso_c_binding
   character(kind=C_CHAR, len=*), intent(out) :: a
   integer(C_INT), value :: n
@@ -20,13 +20,13 @@  program testit
   implicit none
 
   interface
-    subroutine ctest (a, n) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine ctest (a, n) bind (c)
       use iso_c_binding
       character(kind=C_CHAR, len=*), intent(out) :: a
       integer(C_INT), value :: n
     end subroutine
 
-    subroutine ftest (a, n) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine ftest (a, n) bind (c)
       use iso_c_binding
       character(kind=C_CHAR, len=*), intent(out) :: a
       integer(C_INT), value :: n
diff --git a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
index bd6d9cb3dd9..3c3c2574101 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
@@ -16,12 +16,12 @@  module m
   interface
 
     ! These are supposed to be OK
-    subroutine good1 (x, n) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine good1 (x, n) bind (c)
       use iso_c_binding
       character (kind=C_CHAR, len=:), allocatable :: x
       integer(C_INT), value :: n
     end subroutine
-    subroutine good2 (x, n) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine good2 (x, n) bind (c)
       use iso_c_binding
       character (kind=C_CHAR, len=:), pointer :: x
       integer(C_INT), value :: n
diff --git a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-2.f90
index 9fd046def4c..356097af241 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-2.f90
@@ -43,7 +43,7 @@  program testit
       p = 'bar'
     end subroutine
 
-    subroutine frobc (a, p) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine frobc (a, p) bind (c)
       use iso_c_binding
       character (kind=C_CHAR, len=:), allocatable :: a
       character (kind=C_CHAR, len=:), pointer :: p
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-3.f90
index 174d1e728fd..c65cb7a3944 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-3.f90
@@ -1,5 +1,5 @@ 
 ! PR 101308
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "fc-descriptor-3-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-5.f90
index 5ac406fdcc1..eda65b431db 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-5.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-5.f90
@@ -11,7 +11,7 @@  program testit
   implicit none
 
   interface
-    subroutine ctest (a) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine ctest (a) bind (c)
       use iso_c_binding
       character(len=*,kind=C_CHAR) :: a
     end subroutine
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-6.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-6.f90
index 8c544d18402..1d6d006853d 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-6.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-6.f90
@@ -1,5 +1,5 @@ 
 ! Reported as pr94070.
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "fc-descriptor-6-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-3.f90
index c555ada7996..00a083e269e 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-3.f90
@@ -1,5 +1,5 @@ 
 ! PR 101308
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "fc-out-descriptor-3-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-4.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-4.f90
index b4f6654c2e1..a26d4955200 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-4.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-4.f90
@@ -1,5 +1,5 @@ 
 ! PR 92621 (?)
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "fc-out-descriptor-4-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-5.f90
index 836683bd971..63fc08f8bb0 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-5.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-5.f90
@@ -10,7 +10,7 @@  program testit
   implicit none
 
   interface
-    subroutine ctest (a) bind (c)  ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+    subroutine ctest (a) bind (c)
       use iso_c_binding
       character(len=*,kind=C_CHAR), intent(out) :: a
     end subroutine
@@ -26,7 +26,7 @@  program testit
   call ftest (aa)
 
 contains
-  subroutine ftest (a) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+  subroutine ftest (a) bind (c)
     use iso_c_binding
     character(len=*,kind=C_CHAR), intent(out) :: a
     call ctest (a)
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-6.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-6.f90
index d0c3904e27e..da226158a35 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-6.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-out-descriptor-6.f90
@@ -1,5 +1,5 @@ 
 ! Reported as pr94070.
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "fc-out-descriptor-6-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/ff-descriptor-5.f90 b/gcc/testsuite/gfortran.dg/c-interop/ff-descriptor-5.f90
index 2420b7d3731..e6d17a401cd 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/ff-descriptor-5.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/ff-descriptor-5.f90
@@ -17,7 +17,7 @@  contains
 
   ! C binding version
 
-  subroutine checkc (a) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+  subroutine checkc (a) bind (c)
     use iso_c_binding
     character(len=*,kind=C_CHAR) :: a
 
@@ -37,7 +37,7 @@  contains
   end subroutine
 
   ! C binding version
-  subroutine testc (a) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
+  subroutine testc (a) bind (c)
     use iso_c_binding
     character(len=*,kind=C_CHAR) :: a
 
diff --git a/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char-c.c b/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char-c.c
index c69d2242865..ca2f49dc531 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char-c.c
+++ b/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char-c.c
@@ -33,3 +33,9 @@  ctest_1 (CFI_cdesc_t *arg_char, CFI_cdesc_t *arg_ucs4)
   check (arg_ucs4, 4, CFI_type_ucs4_char);
 }
 
+void
+ctest_5 (CFI_cdesc_t *arg_char, CFI_cdesc_t *arg_ucs4)
+{
+  check (arg_char, 5*1, CFI_type_char);
+  check (arg_ucs4, 5*4, CFI_type_ucs4_char);
+}
diff --git a/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char.f90 b/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char.f90
index ede9fb6039a..71f84d0f37a 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/typecodes-array-char.f90
@@ -27,11 +27,21 @@  program testit
       character(kind=ucs4) :: arg_ucs4(:)
     end subroutine
 
+    subroutine ctest_5 (arg_cchar, arg_ucs4) bind (c)
+      use iso_c_binding
+      integer, parameter :: ucs4  = selected_char_kind ('ISO_10646')
+      character(kind=C_CHAR,len=*) :: arg_cchar(:)
+      character(kind=ucs4,len=*) :: arg_ucs4(:)
+    end subroutine
+
   end interface
 
   character(kind=C_CHAR) :: var_cchar(4)
   character(kind=ucs4) :: var_ucs4(4)
+  character(kind=C_CHAR,len=5) :: var_cchar_5(4)
+  character(kind=ucs4,len=5) :: var_ucs4_5(4)
 
   call ctest_1 (var_cchar, var_ucs4)
+  call ctest_5 (var_cchar_5, var_ucs4_5)
 
 end program
diff --git a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-float128.f90 b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-float128.f90
index edf91450ff8..c2275c4face 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-float128.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-float128.f90
@@ -1,7 +1,7 @@ 
 ! xfailed due to PR 101308
 ! PR 101305
 ! PR 100914
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-require-effective-target fortran_real_c_float128 }
 ! { dg-additional-sources "typecodes-scalar-float128-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
diff --git a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-int128.f90 b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-int128.f90
index 5f3c7e1ccf7..157c4ca1f65 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-int128.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-int128.f90
@@ -1,6 +1,6 @@ 
 ! PR 101305
 ! xfailed due to PR 101308
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-require-effective-target fortran_integer_16 }
 ! { dg-additional-sources "typecodes-scalar-int128-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
diff --git a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-longdouble.f90 b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-longdouble.f90
index c32e01218b6..ddc54f4d672 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-longdouble.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/typecodes-scalar-longdouble.f90
@@ -1,7 +1,7 @@ 
 ! xfailed due to PR 101308
 ! PR 101305
 ! PR 100917
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "typecodes-scalar-longdouble-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
index a2616568b2a..2a4a618fa50 100644
--- a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
@@ -4,8 +4,7 @@ 
 !
 ! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
 !
-subroutine bar(c,d) BIND(C) ! { dg-error "character dummy argument 'c' at .1. with assumed length is not yet supported for procedure 'bar' with BIND\\(C\\) attribute" }
-                            ! { dg-error "Character dummy argument 'd' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'bar' has the BIND\\(C\\) attribute" "" { target *-*-* } .-1 }
+subroutine bar(c,d) BIND(C) ! { dg-error "Character dummy argument 'd' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'bar' has the BIND\\(C\\) attribute" }
   character (len=*) c
   character (len=2) d
 end
diff --git a/libgfortran/ISO_Fortran_binding-1-tmpl.h b/libgfortran/ISO_Fortran_binding-1-tmpl.h
index b998d6ca8ee..03b1e2dfd37 100644
--- a/libgfortran/ISO_Fortran_binding-1-tmpl.h
+++ b/libgfortran/ISO_Fortran_binding-1-tmpl.h
@@ -152,14 +152,10 @@  extern int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []);
 #define CFI_type_Complex 4
 #define CFI_type_Character 5
 
-/* Types with no kind.  FIXME: GFC descriptors currently use BT_VOID for
-   both C_PTR and C_FUNPTR, so we have no choice but to make them
-   identical here too.  That can potentially break on targets where
-   function and data pointers have different sizes/representations.
-   See PR 100915.  */
+/* Types with no kind.  */
 #define CFI_type_struct 6
 #define CFI_type_cptr 7
-#define CFI_type_cfunptr CFI_type_cptr
+#define CFI_type_cfunptr 8
 #define CFI_type_other -1
 
 /* Types with kind parameter.
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 0e1a419460a..9c49b2ab811 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -34,6 +34,8 @@  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 extern void cfi_desc_to_gfc_desc (gfc_array_void *, CFI_cdesc_t **);
 export_proto(cfi_desc_to_gfc_desc);
 
+/* NOTE: Since GCC 12, the FE generates code to do the conversion
+   directly without calling this function.  */
 void
 cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
 {
@@ -122,6 +124,8 @@  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
 extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
 export_proto(gfc_desc_to_cfi_desc);
 
+/* NOTE: Since GCC 12, the FE generates code to do the conversion
+   directly without calling this function.  */
 void
 gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
 {
diff --git a/libgomp/testsuite/libgomp.fortran/optional-bind-c.f90 b/libgomp/testsuite/libgomp.fortran/optional-bind-c.f90
new file mode 100644
index 00000000000..6ad6eadbcd2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/optional-bind-c.f90
@@ -0,0 +1,18 @@ 
+! With bind(C), the C (CFI) array descriptor is converted to
+! a Fortran array descriptor - thus, internally a PARM_DECL is
+! converted to a VAR_DECL - check that the optional check still works
+
+module m
+contains
+subroutine foo(x, y)  bind(C)
+  integer, optional :: x,y(:)
+  !$omp target map(tofrom:x)
+     if (present (x)) x = 5
+     if (present (y)) y(1) = 5
+  !$omp end target
+end
+end
+
+use m
+call foo()
+end