[fortran] PRs 89843 and 90022 - C Fortran Interop fixes.

Message ID CAGkQGiJoEPMO=a4UcOitX4JTCCBQrytB326S2SuYWTT=afvAew@mail.gmail.com
State New
Headers show
Series
  • [fortran] PRs 89843 and 90022 - C Fortran Interop fixes.
Related show

Commit Message

Paul Richard Thomas April 9, 2019, 10:18 a.m.
The most part of this patch is concerned with implementing calls from
C of of fortran bind c procedures with assumed shape or assumed rank
dummies to completely fix PR89843. The conversion of the descriptors
from CFI to gfc occur on entry to and reversed on exit from the
procedure.

This patch is safe for trunk, even at this late stage, because its
effects are barricaded behind the tests for CFI descriptors. I believe
that it appropriately rewards the bug reporters to have this feature
work as well as possible at release.

Between comments and the ChangeLogs, this patch is self explanatory.

Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

Paul

2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed
    rank dummies of bind C procs require deferred initialization.
    (convert_CFI_desc): New procedure to convert incoming CFI
    descriptors to gfc types and back again.
    (gfc_trans_deferred_vars): Call it.
    * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI
    descriptor pointer. Free the descriptor in all cases.

    PR fortran/90022
    * trans-decl.c (gfc_get_symbol_decl): Make sure that the se
    expression is a pointer type before converting it to the symbol
    backend_decl type.

2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x
    in ctg. Test the conversion of the descriptor types in the main
    program.
    * gfortran.dg/ISO_Fortran_binding_10.f90: New test.
    * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

    PR fortran/90022
    * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for
    the computation of 'ans'. Also, change the expected results for
    CFI_is_contiguous to comply with standard.
    * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected
    results for CFI_is_contiguous to comply with standard.
    * gfortran.dg/ISO_Fortran_binding_9.f90: New test.
    * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only
    return immediately if the source pointer is null. Bring
    forward the extraction of the gfc type. Extract the kind so
    that the element size can be correctly computed for sections
    and components of derived type arrays. Remove the free of the
    CFI descriptor since this is now done in trans-expr.c.
    (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it
    is not null.
    (CFI_section): Normalise the difference between the upper and
    lower bounds by the stride to correctly calculate the extents
    of the section.

    PR fortran/90022
    * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return
    1 for true and 0 otherwise to comply with the standard. Correct
    the contiguity check for rank 3 and greater by using the stride
    measure of the lower dimension rather than the element length.

Comments

Steve Kargl April 10, 2019, 1:36 a.m. | #1
On Tue, Apr 09, 2019 at 11:18:11AM +0100, Paul Richard Thomas wrote:
> 

> This patch is safe for trunk, even at this late stage, because its

> effects are barricaded behind the tests for CFI descriptors. I believe

> that it appropriately rewards the bug reporters to have this feature

> work as well as possible at release.

> 


I cannot look at this until Saturday, if no one reviews
by then I'll give it a quick glance.

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
Gilles Gouaillardet April 10, 2019, 6:52 a.m. | #2
Thanks Paul,


I tried the patch and it does fix CFI_is_contigous()


There is still an issue with INTENT(IN)


For example, if we declare

integer :: buf(0:1025,0:1025)

and then

call foo(buf(1:1024,1:1024)

in which foo declares buf as INTENT(IN)


You previously explained buf will be copied in order to enforce INTENT(IN),

and that is why base_addr is not &buf(0,0).

The dim[] of the CFI_cdesc_t structure describes the subarray,

CFI_is_contiguous() returns false, but (it seems) the array was copied 
*and packed*

(base_addr was malloc'ed with size=1024*1024*4).

Bottom line, the CFI_cdesc_t description does not match the contiguous 
layout of the (sub)array copy, and this is an issue.



I previously stated that in my opinion, copy-in was not desirable for 
performance reasons.

I also found an other potential issue with copy-in.

If in Fortran, we

call foo(buf(0,0))

then the C subroutine can only access buf(0,0), and other elements such 
as buf(1025,1025) cannot be accessed.

Such elements are valid in buf, but out of bounds in the copy (that 
contains a single element).

Strictly speaking, I cannot say whether this is a violation of the 
standard or not, but I can see how this will

break a lot of existing apps (once again, those apps might be incorrect 
in the first place, but most of us got used

to them working).

To me, this is a second reason why copy-in is not desirable (at least as 
a default option).



Cheers,


Gilles

On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:
> The most part of this patch is concerned with implementing calls from

> C of of fortran bind c procedures with assumed shape or assumed rank

> dummies to completely fix PR89843. The conversion of the descriptors

> from CFI to gfc occur on entry to and reversed on exit from the

> procedure.

>

> This patch is safe for trunk, even at this late stage, because its

> effects are barricaded behind the tests for CFI descriptors. I believe

> that it appropriately rewards the bug reporters to have this feature

> work as well as possible at release.

>

> Between comments and the ChangeLogs, this patch is self explanatory.

>

> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

>

> Paul

>

> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>

>      PR fortran/89843

>      * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

>      rank dummies of bind C procs require deferred initialization.

>      (convert_CFI_desc): New procedure to convert incoming CFI

>      descriptors to gfc types and back again.

>      (gfc_trans_deferred_vars): Call it.

>      * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

>      descriptor pointer. Free the descriptor in all cases.

>

>      PR fortran/90022

>      * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

>      expression is a pointer type before converting it to the symbol

>      backend_decl type.

>

> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>

>      PR fortran/89843

>      * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

>      in ctg. Test the conversion of the descriptor types in the main

>      program.

>      * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

>      * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

>

>      PR fortran/90022

>      * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

>      the computation of 'ans'. Also, change the expected results for

>      CFI_is_contiguous to comply with standard.

>      * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

>      results for CFI_is_contiguous to comply with standard.

>      * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

>      * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

>

> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>

>      PR fortran/89843

>      * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

>      return immediately if the source pointer is null. Bring

>      forward the extraction of the gfc type. Extract the kind so

>      that the element size can be correctly computed for sections

>      and components of derived type arrays. Remove the free of the

>      CFI descriptor since this is now done in trans-expr.c.

>      (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

>      is not null.

>      (CFI_section): Normalise the difference between the upper and

>      lower bounds by the stride to correctly calculate the extents

>      of the section.

>

>      PR fortran/90022

>      * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

>      1 for true and 0 otherwise to comply with the standard. Correct

>      the contiguity check for rank 3 and greater by using the stride

>      measure of the lower dimension rather than the element length.
Bader, Reinhold April 10, 2019, 7:22 a.m. | #3
Hi Gilles,

>

> I also found an other potential issue with copy-in.

>

> If in Fortran, we

>

> call foo(buf(0,0))

>

> then the C subroutine can only access buf(0,0), and other elements such

> as buf(1025,1025) cannot be accessed.

>

> Such elements are valid in buf, but out of bounds in the copy (that

> contains a single element).

>

> Strictly speaking, I cannot say whether this is a violation of the

> standard or not, but I can see how this will

>

> break a lot of existing apps (once again, those apps might be incorrect

> in the first place, but most of us got used to them working).



The above call will only be conforming if the dummy argument is declared 
assumed or explicit size.
Otherwise, the compiler should reject it due to rank mismatch. For assumed 
rank, the call would be
legitimate, but the rank of the dummy argument is then zero. Even if no 
copy-in is performed,
accessing data beyond the address range of that scalar is not strictly 
allowed.

Of more interest is the situation where the dummy argument in Fortran is 
declared, e.g.,

TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

The standard's semantics *forbids* performing copy-in/out in this case, IIRC. 
Otherwise
ASYNCHRONOUS semantics would not work, and non-blocking MPI calls would fail 
due
to buffers vanishing into thin air.

Regards
Reinhold

>

> To me, this is a second reason why copy-in is not desirable (at least as

> a default option).

>

>

>

> Cheers,

>

>

> Gilles

>

> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

> > The most part of this patch is concerned with implementing calls from

> > C of of fortran bind c procedures with assumed shape or assumed rank

> > dummies to completely fix PR89843. The conversion of the descriptors

> > from CFI to gfc occur on entry to and reversed on exit from the

> > procedure.

> >

> > This patch is safe for trunk, even at this late stage, because its

> > effects are barricaded behind the tests for CFI descriptors. I believe

> > that it appropriately rewards the bug reporters to have this feature

> > work as well as possible at release.

> >

> > Between comments and the ChangeLogs, this patch is self explanatory.

> >

> > Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

> >

> > Paul

> >

> > 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >

> >      PR fortran/89843

> >      * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

> >      rank dummies of bind C procs require deferred initialization.

> >      (convert_CFI_desc): New procedure to convert incoming CFI

> >      descriptors to gfc types and back again.

> >      (gfc_trans_deferred_vars): Call it.

> >      * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

> >      descriptor pointer. Free the descriptor in all cases.

> >

> >      PR fortran/90022

> >      * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

> >      expression is a pointer type before converting it to the symbol

> >      backend_decl type.

> >

> > 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >

> >      PR fortran/89843

> >      * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

> >      in ctg. Test the conversion of the descriptor types in the main

> >      program.

> >      * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

> >      * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

> >

> >      PR fortran/90022

> >      * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

> >      the computation of 'ans'. Also, change the expected results for

> >      CFI_is_contiguous to comply with standard.

> >      * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

> >      results for CFI_is_contiguous to comply with standard.

> >      * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

> >      * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

> >

> > 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >

> >      PR fortran/89843

> >      * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

> >      return immediately if the source pointer is null. Bring

> >      forward the extraction of the gfc type. Extract the kind so

> >      that the element size can be correctly computed for sections

> >      and components of derived type arrays. Remove the free of the

> >      CFI descriptor since this is now done in trans-expr.c.

> >      (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

> >      is not null.

> >      (CFI_section): Normalise the difference between the upper and

> >      lower bounds by the stride to correctly calculate the extents

> >      of the section.

> >

> >      PR fortran/90022

> >      * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

> >      1 for true and 0 otherwise to comply with the standard. Correct

> >      the contiguity check for rank 3 and greater by using the stride

> >      measure of the lower dimension rather than the element length.
Gilles Gouaillardet April 12, 2019, 12:25 a.m. | #4
Reinhold,


Thanks for the insights !


That means there is currently an other issue since copy-in is performed 
even if the argument is declared as ASYNCHRONOUS.


I gave the copy-in mechanism some more thoughts, and as a library 
developers, I can clearly see a need *not* to do that

on a case-by-case basis, mainly for performance reasons, but also to be 
friendly with legacy apps that are not strictly standard compliant.

At this stage, I think the best way to move forward is to add an other 
directive in the interface definition.


for example, we could declare


module foo

interface

subroutine bar_f08(buf) BIND(C, name="bar_c")

implicit none

!GCC$ ATTRIBUTES NO_COPY_IN :: buf

TYPE(*), DIMENSION(..), INTENT(IN) :: buf

end subroutine

end interface

end module


Does this make sense ?


Gilles

On 4/10/2019 4:22 PM, Bader, Reinhold wrote:
> Hi Gilles,

>

>> I also found an other potential issue with copy-in.

>>

>> If in Fortran, we

>>

>> call foo(buf(0,0))

>>

>> then the C subroutine can only access buf(0,0), and other elements such

>> as buf(1025,1025) cannot be accessed.

>>

>> Such elements are valid in buf, but out of bounds in the copy (that

>> contains a single element).

>>

>> Strictly speaking, I cannot say whether this is a violation of the

>> standard or not, but I can see how this will

>>

>> break a lot of existing apps (once again, those apps might be incorrect

>> in the first place, but most of us got used to them working).

>

> The above call will only be conforming if the dummy argument is declared

> assumed or explicit size.

> Otherwise, the compiler should reject it due to rank mismatch. For assumed

> rank, the call would be

> legitimate, but the rank of the dummy argument is then zero. Even if no

> copy-in is performed,

> accessing data beyond the address range of that scalar is not strictly

> allowed.

>

> Of more interest is the situation where the dummy argument in Fortran is

> declared, e.g.,

>

> TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

>

> The standard's semantics *forbids* performing copy-in/out in this case, IIRC.

> Otherwise

> ASYNCHRONOUS semantics would not work, and non-blocking MPI calls would fail

> due

> to buffers vanishing into thin air.

>

> Regards

> Reinhold

>

>> To me, this is a second reason why copy-in is not desirable (at least as

>> a default option).

>>

>>

>>

>> Cheers,

>>

>>

>> Gilles

>>

>> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

>>> The most part of this patch is concerned with implementing calls from

>>> C of of fortran bind c procedures with assumed shape or assumed rank

>>> dummies to completely fix PR89843. The conversion of the descriptors

>>> from CFI to gfc occur on entry to and reversed on exit from the

>>> procedure.

>>>

>>> This patch is safe for trunk, even at this late stage, because its

>>> effects are barricaded behind the tests for CFI descriptors. I believe

>>> that it appropriately rewards the bug reporters to have this feature

>>> work as well as possible at release.

>>>

>>> Between comments and the ChangeLogs, this patch is self explanatory.

>>>

>>> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

>>>

>>> Paul

>>>

>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>

>>>       PR fortran/89843

>>>       * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

>>>       rank dummies of bind C procs require deferred initialization.

>>>       (convert_CFI_desc): New procedure to convert incoming CFI

>>>       descriptors to gfc types and back again.

>>>       (gfc_trans_deferred_vars): Call it.

>>>       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

>>>       descriptor pointer. Free the descriptor in all cases.

>>>

>>>       PR fortran/90022

>>>       * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

>>>       expression is a pointer type before converting it to the symbol

>>>       backend_decl type.

>>>

>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>

>>>       PR fortran/89843

>>>       * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

>>>       in ctg. Test the conversion of the descriptor types in the main

>>>       program.

>>>       * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

>>>       * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

>>>

>>>       PR fortran/90022

>>>       * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

>>>       the computation of 'ans'. Also, change the expected results for

>>>       CFI_is_contiguous to comply with standard.

>>>       * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

>>>       results for CFI_is_contiguous to comply with standard.

>>>       * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

>>>       * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

>>>

>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>

>>>       PR fortran/89843

>>>       * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

>>>       return immediately if the source pointer is null. Bring

>>>       forward the extraction of the gfc type. Extract the kind so

>>>       that the element size can be correctly computed for sections

>>>       and components of derived type arrays. Remove the free of the

>>>       CFI descriptor since this is now done in trans-expr.c.

>>>       (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

>>>       is not null.

>>>       (CFI_section): Normalise the difference between the upper and

>>>       lower bounds by the stride to correctly calculate the extents

>>>       of the section.

>>>

>>>       PR fortran/90022

>>>       * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

>>>       1 for true and 0 otherwise to comply with the standard. Correct

>>>       the contiguity check for rank 3 and greater by using the stride

>>>       measure of the lower dimension rather than the element length.
Bader, Reinhold April 12, 2019, 7:53 a.m. | #5
Dear Gilles, 

> -----Ursprüngliche Nachricht-----

> Von: Gilles Gouaillardet <gilles@rist.or.jp>

> Gesendet: Freitag, 12. April 2019 02:25

> An: Bader, Reinhold <Reinhold.Bader@lrz.de>; Paul Richard Thomas

> <paul.richard.thomas@gmail.com>; fortran@gcc.gnu.org; gcc-patches <gcc-

> patches@gcc.gnu.org>

> Betreff: Re: AW: [Patch, fortran] PRs 89843 and 90022 - C Fortran Interop

> fixes.

> 

> Reinhold,

> 

> 

> Thanks for the insights !

> 

> 

> That means there is currently an other issue since copy-in is performed even

> if the argument is declared as ASYNCHRONOUS.

> 

> 

> I gave the copy-in mechanism some more thoughts, and as a library

> developers, I can clearly see a need *not* to do that

> 

> on a case-by-case basis, mainly for performance reasons, but also to be

> friendly with legacy apps that are not strictly standard compliant.

> 

> At this stage, I think the best way to move forward is to add an other

> directive in the interface definition.

> 

> 

> for example, we could declare

> 

> 

> module foo

> 

> interface

> 

> subroutine bar_f08(buf) BIND(C, name="bar_c")

> 

> implicit none

> 

> !GCC$ ATTRIBUTES NO_COPY_IN :: buf


maybe so, but some care must be taken to perform proper checking in case copy-in is necessary - these situations exist as well. 
For example, if the declaration for buf is

TYPE(*), DIMENSION(..), INTENT(IN), CONTIGUOUS :: buf

and the actual argument is a discontiguous array section.

My preference is for the compiler to automatically avoid copy-in whenever possible.

Cheers
Reinhold


> 

> TYPE(*), DIMENSION(..), INTENT(IN) :: buf

> 

> end subroutine

> 

> end interface

> 

> end module

> 

> 

> Does this make sense ?

> 

> 

> Gilles

> 

> On 4/10/2019 4:22 PM, Bader, Reinhold wrote:

> > Hi Gilles,

> >

> >> I also found an other potential issue with copy-in.

> >>

> >> If in Fortran, we

> >>

> >> call foo(buf(0,0))

> >>

> >> then the C subroutine can only access buf(0,0), and other elements such

> >> as buf(1025,1025) cannot be accessed.

> >>

> >> Such elements are valid in buf, but out of bounds in the copy (that

> >> contains a single element).

> >>

> >> Strictly speaking, I cannot say whether this is a violation of the

> >> standard or not, but I can see how this will

> >>

> >> break a lot of existing apps (once again, those apps might be incorrect

> >> in the first place, but most of us got used to them working).

> >

> > The above call will only be conforming if the dummy argument is declared

> > assumed or explicit size.

> > Otherwise, the compiler should reject it due to rank mismatch. For

> assumed

> > rank, the call would be

> > legitimate, but the rank of the dummy argument is then zero. Even if no

> > copy-in is performed,

> > accessing data beyond the address range of that scalar is not strictly

> > allowed.

> >

> > Of more interest is the situation where the dummy argument in Fortran is

> > declared, e.g.,

> >

> > TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

> >

> > The standard's semantics *forbids* performing copy-in/out in this case,

> IIRC.

> > Otherwise

> > ASYNCHRONOUS semantics would not work, and non-blocking MPI calls

> would fail

> > due

> > to buffers vanishing into thin air.

> >

> > Regards

> > Reinhold

> >

> >> To me, this is a second reason why copy-in is not desirable (at least as

> >> a default option).

> >>

> >>

> >>

> >> Cheers,

> >>

> >>

> >> Gilles

> >>

> >> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

> >>> The most part of this patch is concerned with implementing calls from

> >>> C of of fortran bind c procedures with assumed shape or assumed rank

> >>> dummies to completely fix PR89843. The conversion of the descriptors

> >>> from CFI to gfc occur on entry to and reversed on exit from the

> >>> procedure.

> >>>

> >>> This patch is safe for trunk, even at this late stage, because its

> >>> effects are barricaded behind the tests for CFI descriptors. I believe

> >>> that it appropriately rewards the bug reporters to have this feature

> >>> work as well as possible at release.

> >>>

> >>> Between comments and the ChangeLogs, this patch is self explanatory.

> >>>

> >>> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

> >>>

> >>> Paul

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

> >>>       rank dummies of bind C procs require deferred initialization.

> >>>       (convert_CFI_desc): New procedure to convert incoming CFI

> >>>       descriptors to gfc types and back again.

> >>>       (gfc_trans_deferred_vars): Call it.

> >>>       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

> >>>       descriptor pointer. Free the descriptor in all cases.

> >>>

> >>>       PR fortran/90022

> >>>       * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

> >>>       expression is a pointer type before converting it to the symbol

> >>>       backend_decl type.

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

> >>>       in ctg. Test the conversion of the descriptor types in the main

> >>>       program.

> >>>       * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

> >>>       * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

> >>>

> >>>       PR fortran/90022

> >>>       * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

> >>>       the computation of 'ans'. Also, change the expected results for

> >>>       CFI_is_contiguous to comply with standard.

> >>>       * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

> >>>       results for CFI_is_contiguous to comply with standard.

> >>>       * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

> >>>       * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

> >>>       return immediately if the source pointer is null. Bring

> >>>       forward the extraction of the gfc type. Extract the kind so

> >>>       that the element size can be correctly computed for sections

> >>>       and components of derived type arrays. Remove the free of the

> >>>       CFI descriptor since this is now done in trans-expr.c.

> >>>       (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

> >>>       is not null.

> >>>       (CFI_section): Normalise the difference between the upper and

> >>>       lower bounds by the stride to correctly calculate the extents

> >>>       of the section.

> >>>

> >>>       PR fortran/90022

> >>>       * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

> >>>       1 for true and 0 otherwise to comply with the standard. Correct

> >>>       the contiguity check for rank 3 and greater by using the stride

> >>>       measure of the lower dimension rather than the element length.
Gilles Gouaillardet April 12, 2019, 8:36 a.m. | #6
Dear Reinhold,


Thanks again for the insight !


My preference is also to avoid copy-in whenever possible.

But since my primary concern is performance (vs enforcing correctness of 
the user apps), I am not willing to

use existing bugs to (fallaciously) conclude copy-in should be simply 
dropped (unless mandatory).


Cheers,


Gilles

On 4/12/2019 4:53 PM, Bader, Reinhold wrote:
> Dear Gilles,

>

>> -----Ursprüngliche Nachricht-----

>> Von: Gilles Gouaillardet <gilles@rist.or.jp>

>> Gesendet: Freitag, 12. April 2019 02:25

>> An: Bader, Reinhold <Reinhold.Bader@lrz.de>; Paul Richard Thomas

>> <paul.richard.thomas@gmail.com>; fortran@gcc.gnu.org; gcc-patches <gcc-

>> patches@gcc.gnu.org>

>> Betreff: Re: AW: [Patch, fortran] PRs 89843 and 90022 - C Fortran Interop

>> fixes.

>>

>> Reinhold,

>>

>>

>> Thanks for the insights !

>>

>>

>> That means there is currently an other issue since copy-in is performed even

>> if the argument is declared as ASYNCHRONOUS.

>>

>>

>> I gave the copy-in mechanism some more thoughts, and as a library

>> developers, I can clearly see a need *not* to do that

>>

>> on a case-by-case basis, mainly for performance reasons, but also to be

>> friendly with legacy apps that are not strictly standard compliant.

>>

>> At this stage, I think the best way to move forward is to add an other

>> directive in the interface definition.

>>

>>

>> for example, we could declare

>>

>>

>> module foo

>>

>> interface

>>

>> subroutine bar_f08(buf) BIND(C, name="bar_c")

>>

>> implicit none

>>

>> !GCC$ ATTRIBUTES NO_COPY_IN :: buf

> maybe so, but some care must be taken to perform proper checking in case copy-in is necessary - these situations exist as well.

> For example, if the declaration for buf is

>

> TYPE(*), DIMENSION(..), INTENT(IN), CONTIGUOUS :: buf

>

> and the actual argument is a discontiguous array section.

>

> My preference is for the compiler to automatically avoid copy-in whenever possible.

>

> Cheers

> Reinhold

>

>

>> TYPE(*), DIMENSION(..), INTENT(IN) :: buf

>>

>> end subroutine

>>

>> end interface

>>

>> end module

>>

>>

>> Does this make sense ?

>>

>>

>> Gilles

>>

>> On 4/10/2019 4:22 PM, Bader, Reinhold wrote:

>>> Hi Gilles,

>>>

>>>> I also found an other potential issue with copy-in.

>>>>

>>>> If in Fortran, we

>>>>

>>>> call foo(buf(0,0))

>>>>

>>>> then the C subroutine can only access buf(0,0), and other elements such

>>>> as buf(1025,1025) cannot be accessed.

>>>>

>>>> Such elements are valid in buf, but out of bounds in the copy (that

>>>> contains a single element).

>>>>

>>>> Strictly speaking, I cannot say whether this is a violation of the

>>>> standard or not, but I can see how this will

>>>>

>>>> break a lot of existing apps (once again, those apps might be incorrect

>>>> in the first place, but most of us got used to them working).

>>> The above call will only be conforming if the dummy argument is declared

>>> assumed or explicit size.

>>> Otherwise, the compiler should reject it due to rank mismatch. For

>> assumed

>>> rank, the call would be

>>> legitimate, but the rank of the dummy argument is then zero. Even if no

>>> copy-in is performed,

>>> accessing data beyond the address range of that scalar is not strictly

>>> allowed.

>>>

>>> Of more interest is the situation where the dummy argument in Fortran is

>>> declared, e.g.,

>>>

>>> TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

>>>

>>> The standard's semantics *forbids* performing copy-in/out in this case,

>> IIRC.

>>> Otherwise

>>> ASYNCHRONOUS semantics would not work, and non-blocking MPI calls

>> would fail

>>> due

>>> to buffers vanishing into thin air.

>>>

>>> Regards

>>> Reinhold

>>>

>>>> To me, this is a second reason why copy-in is not desirable (at least as

>>>> a default option).

>>>>

>>>>

>>>>

>>>> Cheers,

>>>>

>>>>

>>>> Gilles

>>>>

>>>> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

>>>>> The most part of this patch is concerned with implementing calls from

>>>>> C of of fortran bind c procedures with assumed shape or assumed rank

>>>>> dummies to completely fix PR89843. The conversion of the descriptors

>>>>> from CFI to gfc occur on entry to and reversed on exit from the

>>>>> procedure.

>>>>>

>>>>> This patch is safe for trunk, even at this late stage, because its

>>>>> effects are barricaded behind the tests for CFI descriptors. I believe

>>>>> that it appropriately rewards the bug reporters to have this feature

>>>>> work as well as possible at release.

>>>>>

>>>>> Between comments and the ChangeLogs, this patch is self explanatory.

>>>>>

>>>>> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

>>>>>

>>>>> Paul

>>>>>

>>>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>>>

>>>>>        PR fortran/89843

>>>>>        * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

>>>>>        rank dummies of bind C procs require deferred initialization.

>>>>>        (convert_CFI_desc): New procedure to convert incoming CFI

>>>>>        descriptors to gfc types and back again.

>>>>>        (gfc_trans_deferred_vars): Call it.

>>>>>        * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

>>>>>        descriptor pointer. Free the descriptor in all cases.

>>>>>

>>>>>        PR fortran/90022

>>>>>        * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

>>>>>        expression is a pointer type before converting it to the symbol

>>>>>        backend_decl type.

>>>>>

>>>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>>>

>>>>>        PR fortran/89843

>>>>>        * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

>>>>>        in ctg. Test the conversion of the descriptor types in the main

>>>>>        program.

>>>>>        * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

>>>>>        * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

>>>>>

>>>>>        PR fortran/90022

>>>>>        * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

>>>>>        the computation of 'ans'. Also, change the expected results for

>>>>>        CFI_is_contiguous to comply with standard.

>>>>>        * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

>>>>>        results for CFI_is_contiguous to comply with standard.

>>>>>        * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

>>>>>        * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

>>>>>

>>>>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

>>>>>

>>>>>        PR fortran/89843

>>>>>        * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

>>>>>        return immediately if the source pointer is null. Bring

>>>>>        forward the extraction of the gfc type. Extract the kind so

>>>>>        that the element size can be correctly computed for sections

>>>>>        and components of derived type arrays. Remove the free of the

>>>>>        CFI descriptor since this is now done in trans-expr.c.

>>>>>        (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

>>>>>        is not null.

>>>>>        (CFI_section): Normalise the difference between the upper and

>>>>>        lower bounds by the stride to correctly calculate the extents

>>>>>        of the section.

>>>>>

>>>>>        PR fortran/90022

>>>>>        * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

>>>>>        1 for true and 0 otherwise to comply with the standard. Correct

>>>>>        the contiguity check for rank 3 and greater by using the stride

>>>>>        measure of the lower dimension rather than the element length.
Paul Richard Thomas April 12, 2019, 9:08 a.m. | #7
Gilles & Reinhold,

Following the discussion, I have decided to remove the copy-in for
intent(in). Dominique and I have located the problem with -m32 for
PR90022 and I am working on PR89846 right now.

I will be resubmitting a bit later on.

Cheers

Paul


On Fri, 12 Apr 2019 at 01:25, Gilles Gouaillardet <gilles@rist.or.jp> wrote:
>

> Reinhold,

>

>

> Thanks for the insights !

>

>

> That means there is currently an other issue since copy-in is performed

> even if the argument is declared as ASYNCHRONOUS.

>

>

> I gave the copy-in mechanism some more thoughts, and as a library

> developers, I can clearly see a need *not* to do that

>

> on a case-by-case basis, mainly for performance reasons, but also to be

> friendly with legacy apps that are not strictly standard compliant.

>

> At this stage, I think the best way to move forward is to add an other

> directive in the interface definition.

>

>

> for example, we could declare

>

>

> module foo

>

> interface

>

> subroutine bar_f08(buf) BIND(C, name="bar_c")

>

> implicit none

>

> !GCC$ ATTRIBUTES NO_COPY_IN :: buf

>

> TYPE(*), DIMENSION(..), INTENT(IN) :: buf

>

> end subroutine

>

> end interface

>

> end module

>

>

> Does this make sense ?

>

>

> Gilles

>

> On 4/10/2019 4:22 PM, Bader, Reinhold wrote:

> > Hi Gilles,

> >

> >> I also found an other potential issue with copy-in.

> >>

> >> If in Fortran, we

> >>

> >> call foo(buf(0,0))

> >>

> >> then the C subroutine can only access buf(0,0), and other elements such

> >> as buf(1025,1025) cannot be accessed.

> >>

> >> Such elements are valid in buf, but out of bounds in the copy (that

> >> contains a single element).

> >>

> >> Strictly speaking, I cannot say whether this is a violation of the

> >> standard or not, but I can see how this will

> >>

> >> break a lot of existing apps (once again, those apps might be incorrect

> >> in the first place, but most of us got used to them working).

> >

> > The above call will only be conforming if the dummy argument is declared

> > assumed or explicit size.

> > Otherwise, the compiler should reject it due to rank mismatch. For assumed

> > rank, the call would be

> > legitimate, but the rank of the dummy argument is then zero. Even if no

> > copy-in is performed,

> > accessing data beyond the address range of that scalar is not strictly

> > allowed.

> >

> > Of more interest is the situation where the dummy argument in Fortran is

> > declared, e.g.,

> >

> > TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

> >

> > The standard's semantics *forbids* performing copy-in/out in this case, IIRC.

> > Otherwise

> > ASYNCHRONOUS semantics would not work, and non-blocking MPI calls would fail

> > due

> > to buffers vanishing into thin air.

> >

> > Regards

> > Reinhold

> >

> >> To me, this is a second reason why copy-in is not desirable (at least as

> >> a default option).

> >>

> >>

> >>

> >> Cheers,

> >>

> >>

> >> Gilles

> >>

> >> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

> >>> The most part of this patch is concerned with implementing calls from

> >>> C of of fortran bind c procedures with assumed shape or assumed rank

> >>> dummies to completely fix PR89843. The conversion of the descriptors

> >>> from CFI to gfc occur on entry to and reversed on exit from the

> >>> procedure.

> >>>

> >>> This patch is safe for trunk, even at this late stage, because its

> >>> effects are barricaded behind the tests for CFI descriptors. I believe

> >>> that it appropriately rewards the bug reporters to have this feature

> >>> work as well as possible at release.

> >>>

> >>> Between comments and the ChangeLogs, this patch is self explanatory.

> >>>

> >>> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

> >>>

> >>> Paul

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

> >>>       rank dummies of bind C procs require deferred initialization.

> >>>       (convert_CFI_desc): New procedure to convert incoming CFI

> >>>       descriptors to gfc types and back again.

> >>>       (gfc_trans_deferred_vars): Call it.

> >>>       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

> >>>       descriptor pointer. Free the descriptor in all cases.

> >>>

> >>>       PR fortran/90022

> >>>       * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

> >>>       expression is a pointer type before converting it to the symbol

> >>>       backend_decl type.

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

> >>>       in ctg. Test the conversion of the descriptor types in the main

> >>>       program.

> >>>       * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

> >>>       * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

> >>>

> >>>       PR fortran/90022

> >>>       * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

> >>>       the computation of 'ans'. Also, change the expected results for

> >>>       CFI_is_contiguous to comply with standard.

> >>>       * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

> >>>       results for CFI_is_contiguous to comply with standard.

> >>>       * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

> >>>       * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

> >>>

> >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> >>>

> >>>       PR fortran/89843

> >>>       * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

> >>>       return immediately if the source pointer is null. Bring

> >>>       forward the extraction of the gfc type. Extract the kind so

> >>>       that the element size can be correctly computed for sections

> >>>       and components of derived type arrays. Remove the free of the

> >>>       CFI descriptor since this is now done in trans-expr.c.

> >>>       (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

> >>>       is not null.

> >>>       (CFI_section): Normalise the difference between the upper and

> >>>       lower bounds by the stride to correctly calculate the extents

> >>>       of the section.

> >>>

> >>>       PR fortran/90022

> >>>       * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

> >>>       1 for true and 0 otherwise to comply with the standard. Correct

> >>>       the contiguity check for rank 3 and greater by using the stride

> >>>       measure of the lower dimension rather than the element length.




--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Paul Richard Thomas April 14, 2019, 4:57 p.m. | #8
Dear All,

Please find attached the updated patch, which fixes the problem with
-m32 in PR90022, eliminates the temporary creation for INTENT(IN)
dummies and fixes PR89846.

While it looks like it should be intrusive because of its size, I
believe that the patch is still safe for trunk since it is hidden
behind tests for CFI descriptors.

Bootstraps and regtests on FC29/x86_64 - OK for trunk?

Cheers

Paul

2019-04-14  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed
    rank dummies of bind C procs require deferred initialization.
    (convert_CFI_desc): New procedure to convert incoming CFI
    descriptors to gfc types and back again.
    (gfc_trans_deferred_vars): Call it.
    * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI
    descriptor pointer. Free the descriptor in all cases.

    PR fortran/89846
    * expr.c (is_CFI_desc): New function.
    (is_subref_array): Tidy up by referencing the symbol directly.
    * gfortran.h : Prototype for is_CFI_desc.
    * trans_array.c (get_CFI_desc): New function.
    (gfc_get_array_span, gfc_conv_scalarized_array_ref,
    gfc_conv_array_ref): Use it.
    * trans.c (get_array_span): Extract the span from descriptors
    that are indirect references.

    PR fortran/90022
    * trans-decl.c (gfc_get_symbol_decl): Make sure that the se
    expression is a pointer type before converting it to the symbol
    backend_decl type.
    * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Eliminate
    temporary creation for intent(in).

2019-04-14  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x
    in ctg. Test the conversion of the descriptor types in the main
    program.
    * gfortran.dg/ISO_Fortran_binding_10.f90: New test.
    * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

    PR fortran/89846
    * gfortran.dg/ISO_Fortran_binding_11.f90: New test.
    * gfortran.dg/ISO_Fortran_binding_11.c: Called by it.

    PR fortran/90022
    * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for
    the computation of 'ans'. Also, change the expected results for
    CFI_is_contiguous to comply with standard.
    * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected
    results for CFI_is_contiguous to comply with standard.
    * gfortran.dg/ISO_Fortran_binding_9.f90: New test.
    * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

2019-04-14  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/89843
    * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only
    return immediately if the source pointer is null. Bring
    forward the extraction of the gfc type. Extract the kind so
    that the element size can be correctly computed for sections
    and components of derived type arrays. Remove the free of the
    CFI descriptor since this is now done in trans-expr.c.
    (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it
    is not null.
    (CFI_section): Normalise the difference between the upper and
    lower bounds by the stride to correctly calculate the extents
    of the section.

    PR fortran/89846
    * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Use
    the stride measure for the gfc span if it is not a multiple
    of the element length. Otherwise use the element length.

    PR fortran/90022
    * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return
    1 for true and 0 otherwise to comply with the standard. Correct
    the contiguity check for rank 3 and greater by using the stride
    measure of the lower dimension rather than the element length.

On Fri, 12 Apr 2019 at 10:08, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
>

> Gilles & Reinhold,

>

> Following the discussion, I have decided to remove the copy-in for

> intent(in). Dominique and I have located the problem with -m32 for

> PR90022 and I am working on PR89846 right now.

>

> I will be resubmitting a bit later on.

>

> Cheers

>

> Paul

>

>

> On Fri, 12 Apr 2019 at 01:25, Gilles Gouaillardet <gilles@rist.or.jp> wrote:

> >

> > Reinhold,

> >

> >

> > Thanks for the insights !

> >

> >

> > That means there is currently an other issue since copy-in is performed

> > even if the argument is declared as ASYNCHRONOUS.

> >

> >

> > I gave the copy-in mechanism some more thoughts, and as a library

> > developers, I can clearly see a need *not* to do that

> >

> > on a case-by-case basis, mainly for performance reasons, but also to be

> > friendly with legacy apps that are not strictly standard compliant.

> >

> > At this stage, I think the best way to move forward is to add an other

> > directive in the interface definition.

> >

> >

> > for example, we could declare

> >

> >

> > module foo

> >

> > interface

> >

> > subroutine bar_f08(buf) BIND(C, name="bar_c")

> >

> > implicit none

> >

> > !GCC$ ATTRIBUTES NO_COPY_IN :: buf

> >

> > TYPE(*), DIMENSION(..), INTENT(IN) :: buf

> >

> > end subroutine

> >

> > end interface

> >

> > end module

> >

> >

> > Does this make sense ?

> >

> >

> > Gilles

> >

> > On 4/10/2019 4:22 PM, Bader, Reinhold wrote:

> > > Hi Gilles,

> > >

> > >> I also found an other potential issue with copy-in.

> > >>

> > >> If in Fortran, we

> > >>

> > >> call foo(buf(0,0))

> > >>

> > >> then the C subroutine can only access buf(0,0), and other elements such

> > >> as buf(1025,1025) cannot be accessed.

> > >>

> > >> Such elements are valid in buf, but out of bounds in the copy (that

> > >> contains a single element).

> > >>

> > >> Strictly speaking, I cannot say whether this is a violation of the

> > >> standard or not, but I can see how this will

> > >>

> > >> break a lot of existing apps (once again, those apps might be incorrect

> > >> in the first place, but most of us got used to them working).

> > >

> > > The above call will only be conforming if the dummy argument is declared

> > > assumed or explicit size.

> > > Otherwise, the compiler should reject it due to rank mismatch. For assumed

> > > rank, the call would be

> > > legitimate, but the rank of the dummy argument is then zero. Even if no

> > > copy-in is performed,

> > > accessing data beyond the address range of that scalar is not strictly

> > > allowed.

> > >

> > > Of more interest is the situation where the dummy argument in Fortran is

> > > declared, e.g.,

> > >

> > > TYPE(*), ASYNCHRONOUS, INTENT(IN) :: BUF(..)

> > >

> > > The standard's semantics *forbids* performing copy-in/out in this case, IIRC.

> > > Otherwise

> > > ASYNCHRONOUS semantics would not work, and non-blocking MPI calls would fail

> > > due

> > > to buffers vanishing into thin air.

> > >

> > > Regards

> > > Reinhold

> > >

> > >> To me, this is a second reason why copy-in is not desirable (at least as

> > >> a default option).

> > >>

> > >>

> > >>

> > >> Cheers,

> > >>

> > >>

> > >> Gilles

> > >>

> > >> On 4/9/2019 7:18 PM, Paul Richard Thomas wrote:

> > >>> The most part of this patch is concerned with implementing calls from

> > >>> C of of fortran bind c procedures with assumed shape or assumed rank

> > >>> dummies to completely fix PR89843. The conversion of the descriptors

> > >>> from CFI to gfc occur on entry to and reversed on exit from the

> > >>> procedure.

> > >>>

> > >>> This patch is safe for trunk, even at this late stage, because its

> > >>> effects are barricaded behind the tests for CFI descriptors. I believe

> > >>> that it appropriately rewards the bug reporters to have this feature

> > >>> work as well as possible at release.

> > >>>

> > >>> Between comments and the ChangeLogs, this patch is self explanatory.

> > >>>

> > >>> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

> > >>>

> > >>> Paul

> > >>>

> > >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> > >>>

> > >>>       PR fortran/89843

> > >>>       * trans-decl.c (gfc_get_symbol_decl): Assumed shape and assumed

> > >>>       rank dummies of bind C procs require deferred initialization.

> > >>>       (convert_CFI_desc): New procedure to convert incoming CFI

> > >>>       descriptors to gfc types and back again.

> > >>>       (gfc_trans_deferred_vars): Call it.

> > >>>       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Null the CFI

> > >>>       descriptor pointer. Free the descriptor in all cases.

> > >>>

> > >>>       PR fortran/90022

> > >>>       * trans-decl.c (gfc_get_symbol_decl): Make sure that the se

> > >>>       expression is a pointer type before converting it to the symbol

> > >>>       backend_decl type.

> > >>>

> > >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> > >>>

> > >>>       PR fortran/89843

> > >>>       * gfortran.dg/ISO_Fortran_binding_4.f90: Modify the value of x

> > >>>       in ctg. Test the conversion of the descriptor types in the main

> > >>>       program.

> > >>>       * gfortran.dg/ISO_Fortran_binding_10.f90: New test.

> > >>>       * gfortran.dg/ISO_Fortran_binding_10.c: Called by it.

> > >>>

> > >>>       PR fortran/90022

> > >>>       * gfortran.dg/ISO_Fortran_binding_1.c: Correct the indexing for

> > >>>       the computation of 'ans'. Also, change the expected results for

> > >>>       CFI_is_contiguous to comply with standard.

> > >>>       * gfortran.dg/ISO_Fortran_binding_1.f90: Correct the expected

> > >>>       results for CFI_is_contiguous to comply with standard.

> > >>>       * gfortran.dg/ISO_Fortran_binding_9.f90: New test.

> > >>>       * gfortran.dg/ISO_Fortran_binding_9.c: Called by it.

> > >>>

> > >>> 2019-04-09  Paul Thomas  <pault@gcc.gnu.org>

> > >>>

> > >>>       PR fortran/89843

> > >>>       * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Only

> > >>>       return immediately if the source pointer is null. Bring

> > >>>       forward the extraction of the gfc type. Extract the kind so

> > >>>       that the element size can be correctly computed for sections

> > >>>       and components of derived type arrays. Remove the free of the

> > >>>       CFI descriptor since this is now done in trans-expr.c.

> > >>>       (gfc_desc_to_cfi_desc): Only allocate the CFI descriptor if it

> > >>>       is not null.

> > >>>       (CFI_section): Normalise the difference between the upper and

> > >>>       lower bounds by the stride to correctly calculate the extents

> > >>>       of the section.

> > >>>

> > >>>       PR fortran/90022

> > >>>       * runtime/ISO_Fortran_binding.c (CFI_is_contiguous) : Return

> > >>>       1 for true and 0 otherwise to comply with the standard. Correct

> > >>>       the contiguity check for rank 3 and greater by using the stride

> > >>>       measure of the lower dimension rather than the element length.

>

>

>

> --

> "If you can't explain it simply, you don't understand it well enough"

> - Albert Einstein




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 270149)
--- gcc/fortran/expr.c	(working copy)
*************** gfc_is_constant_expr (gfc_expr *e)
*** 1061,1066 ****
--- 1061,1087 ----
  }
  
  
+ /* Is true if the expression or symbol is a passed CFI descriptor.  */
+ bool
+ is_CFI_desc (gfc_symbol *sym, gfc_expr *e)
+ {
+   if (sym == NULL
+       && e && e->expr_type == EXPR_VARIABLE)
+     sym = e->symtree->n.sym;
+ 
+   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))
+     return true;
+ 
+ return false;
+ }
+ 
+ 
  /* Is true if an array reference is followed by a component or substring
     reference.  */
  bool
*************** is_subref_array (gfc_expr * e)
*** 1068,1078 ****
  {
    gfc_ref * ref;
    bool seen_array;
  
    if (e->expr_type != EXPR_VARIABLE)
      return false;
  
!   if (e->symtree->n.sym->attr.subref_array_pointer)
      return true;
  
    seen_array = false;
--- 1089,1102 ----
  {
    gfc_ref * ref;
    bool seen_array;
+   gfc_symbol *sym;
  
    if (e->expr_type != EXPR_VARIABLE)
      return false;
  
!   sym = e->symtree->n.sym;
! 
!   if (sym->attr.subref_array_pointer)
      return true;
  
    seen_array = false;
*************** is_subref_array (gfc_expr * e)
*** 1097,1106 ****
  	return seen_array;
      }
  
!   if (e->symtree->n.sym->ts.type == BT_CLASS
!       && e->symtree->n.sym->attr.dummy
!       && CLASS_DATA (e->symtree->n.sym)->attr.dimension
!       && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer)
      return true;
  
    return false;
--- 1121,1130 ----
  	return seen_array;
      }
  
!   if (sym->ts.type == BT_CLASS
!       && sym->attr.dummy
!       && CLASS_DATA (sym)->attr.dimension
!       && CLASS_DATA (sym)->attr.class_pointer)
      return true;
  
    return false;
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 270149)
--- gcc/fortran/gfortran.h	(working copy)
*************** gfc_actual_arglist *gfc_copy_actual_argl
*** 3220,3225 ****
--- 3220,3226 ----
  bool gfc_extract_int (gfc_expr *, int *, int = 0);
  bool gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *, int = 0);
  
+ bool is_CFI_desc (gfc_symbol *, gfc_expr *);
  bool is_subref_array (gfc_expr *);
  bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
  bool gfc_is_not_contiguous (gfc_expr *);
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 270149)
--- gcc/fortran/trans-array.c	(working copy)
*************** is_pointer_array (tree expr)
*** 849,854 ****
--- 849,889 ----
  }
  
  
+ /* If the symbol or expression reference a CFI descriptor, return the
+    pointer to the converted gfc descriptor. If an array reference is
+    present as the last argument, check that it is the one applied to
+    the CFI descriptor in the expression. Note that the CFI object is
+    always the symbol in the expression!  */
+ 
+ static bool
+ get_CFI_desc (gfc_symbol *sym, gfc_expr *expr,
+ 	      tree *desc, gfc_array_ref *ar)
+ {
+   tree tmp;
+ 
+   if (!is_CFI_desc (sym, expr))
+     return false;
+ 
+   if (expr && ar)
+     {
+       if (!(expr->ref && expr->ref->type == REF_ARRAY)
+ 	  || (&expr->ref->u.ar != ar))
+ 	return false;
+     }
+ 
+   if (sym == NULL)
+     tmp = expr->symtree->n.sym->backend_decl;
+   else
+     tmp = sym->backend_decl;
+ 
+   if (tmp && DECL_LANG_SPECIFIC (tmp))
+     tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp);
+ 
+   *desc = tmp;
+   return true;
+ }
+ 
+ 
  /* Return the span of an array.  */
  
  tree
*************** gfc_get_array_span (tree desc, gfc_expr
*** 856,864 ****
  {
    tree tmp;
  
!   if (is_pointer_array (desc))
!     /* This will have the span field set.  */
!     tmp = gfc_conv_descriptor_span_get (desc);
    else if (TREE_CODE (desc) == COMPONENT_REF
  	   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
  	   && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0))))
--- 891,904 ----
  {
    tree tmp;
  
!   if (is_pointer_array (desc) || get_CFI_desc (NULL, expr, &desc, NULL))
!     {
!       if (POINTER_TYPE_P (TREE_TYPE (desc)))
! 	desc = build_fold_indirect_ref_loc (input_location, desc);
! 
!       /* This will have the span field set.  */
!       tmp = gfc_conv_descriptor_span_get (desc);
!     }
    else if (TREE_CODE (desc) == COMPONENT_REF
  	   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
  	   && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0))))
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3466,3471 ****
--- 3506,3517 ----
    if (build_class_array_ref (se, base, index))
      return;
  
+   if (get_CFI_desc (NULL, expr, &decl, ar))
+     {
+       decl = build_fold_indirect_ref_loc (input_location, decl);
+       goto done;
+     }
+ 
    if (expr && ((is_subref_array (expr)
  		&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor)))
  	       || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 3721,3726 ****
--- 3767,3774 ----
    /* A pointer array component can be detected from its field decl. Fix
       the descriptor, mark the resulting variable decl and pass it to
       build_array_ref.  */
+   if (get_CFI_desc (sym, expr, &decl, ar))
+     decl = build_fold_indirect_ref_loc (input_location, decl);
    if (!expr->ts.deferred && !sym->attr.codimension
        && is_pointer_array (se->expr))
      {
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 270149)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_null_and_pass_deferred_len (gfc_symb
*** 4268,4273 ****
--- 4268,4339 ----
  }
  
  
+ /* 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 incoming;
+   tree outgoing;
+   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
+     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");
+ 
+       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));
+       incoming = gfc_finish_block (&tmpblock);
+ 
+       gfc_init_block (&tmpblock);
+       /* Convert the gfc descriptor back to the CFI type before going
+ 	 out of scope.  */
+       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 = gfc_finish_block (&tmpblock);
+ 
+       /* 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
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4844,4849 ****
--- 4910,4922 ----
  	}
        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);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 270149)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 4987,4997 ****
    tree tmp;
    tree cfi_desc_ptr;
    tree gfc_desc_ptr;
-   tree ptr = NULL_TREE;
-   tree size;
    tree type;
    int attribute;
    symbol_attribute attr = gfc_expr_attr (e);
  
    /* If this is a full array or a scalar, the allocatable and pointer
       attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
--- 4987,4997 ----
    tree tmp;
    tree cfi_desc_ptr;
    tree gfc_desc_ptr;
    tree type;
+   tree cond;
    int attribute;
    symbol_attribute attr = gfc_expr_attr (e);
+   stmtblock_t block;
  
    /* If this is a full array or a scalar, the allocatable and pointer
       attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5056,5092 ****
  	  tmp = fold_convert (gfc_array_index_type, tmp);
  	  gfc_conv_descriptor_span_set (&parmse->pre, parmse->expr, tmp);
  	}
- 
-       /* INTENT(IN) requires a temporary for the data. Assumed types do not
- 	 work with the standard temporary generation schemes. */
-       if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
- 	{
- 	  /* Fix the descriptor and determine the size of the data.  */
- 	  parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
- 	  size = build_call_expr_loc (input_location,
- 				gfor_fndecl_size0, 1,
- 				gfc_build_addr_expr (NULL, parmse->expr));
- 	  size = fold_convert (size_type_node, size);
- 	  tmp = gfc_conv_descriptor_span_get (parmse->expr);
- 	  tmp = fold_convert (size_type_node, tmp);
- 	  size = fold_build2_loc (input_location, MULT_EXPR,
- 				  size_type_node, size, tmp);
- 	  /* Fix the size and allocate.  */
- 	  size = gfc_evaluate_now (size, &parmse->pre);
- 	  tmp = builtin_decl_explicit (BUILT_IN_MALLOC);
- 	  ptr = build_call_expr_loc (input_location, tmp, 1, size);
- 	  ptr = gfc_evaluate_now (ptr, &parmse->pre);
- 	  /* Copy the data to the temporary descriptor.  */
- 	  tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
- 	  tmp = build_call_expr_loc (input_location, tmp, 3, ptr,
- 				gfc_conv_descriptor_data_get (parmse->expr),
- 				size);
- 	  gfc_add_expr_to_block (&parmse->pre, tmp);
- 
- 	  /* The temporary 'ptr' is freed below.  */
- 	  gfc_conv_descriptor_data_set (&parmse->pre, parmse->expr, ptr);
- 	}
- 
      }
    else
      {
--- 5056,5061 ----
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5096,5123 ****
  	parmse->expr = build_fold_indirect_ref_loc (input_location,
  						    parmse->expr);
  
-       /* Copy the scalar for INTENT(IN).  */
-       if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
- 	{
- 	  if (e->ts.type != BT_CHARACTER)
- 	    parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
- 	  else
- 	    {
- 	      /* The temporary string 'ptr' is freed below.  */
- 	      tmp = build_pointer_type (TREE_TYPE (parmse->expr));
- 	      ptr = gfc_create_var (tmp, "str");
- 	      tmp = build_call_expr_loc (input_location,
- 				 builtin_decl_explicit (BUILT_IN_MALLOC),
- 				 1, parmse->string_length);
- 	      tmp = fold_convert (TREE_TYPE (ptr), tmp);
- 	      gfc_add_modify (&parmse->pre, ptr, tmp);
- 	      tmp = gfc_build_memcpy_call (ptr, parmse->expr,
- 					   parmse->string_length);
- 	      gfc_add_expr_to_block (&parmse->pre, tmp);
- 	      parmse->expr = ptr;
- 	    }
- 	}
- 
        parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
  						    parmse->expr, attr);
      }
--- 5065,5070 ----
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5135,5140 ****
--- 5082,5089 ----
    /* Variables to point to the gfc and CFI descriptors.  */
    gfc_desc_ptr = parmse->expr;
    cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
+   gfc_add_modify (&parmse->pre, cfi_desc_ptr,
+ 		  build_int_cst (pvoid_type_node, 0));
  
    /* Allocate the CFI descriptor and fill the fields.  */
    tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5145,5162 ****
    /* The CFI descriptor is passed to the bind_C procedure.  */
    parmse->expr = cfi_desc_ptr;
  
!   if (ptr)
!     {
!       /* Free both the temporary data and the CFI descriptor for
! 	 INTENT(IN) arrays.  */
!       tmp = gfc_call_free (ptr);
!       gfc_prepend_expr_to_block (&parmse->post, tmp);
!       tmp = gfc_call_free (cfi_desc_ptr);
!       gfc_prepend_expr_to_block (&parmse->post, tmp);
!       return;
!     }
  
!   /* Transfer values back to gfc descriptor and free the CFI descriptor.  */
    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);
--- 5094,5112 ----
    /* The CFI descriptor is passed to the bind_C procedure.  */
    parmse->expr = cfi_desc_ptr;
  
!   /* Free the CFI descriptor.  */
!   gfc_init_block (&block);
!   cond = fold_build2_loc (input_location, NE_EXPR,
! 			  logical_type_node, cfi_desc_ptr,
! 			  build_int_cst (TREE_TYPE (cfi_desc_ptr), 0));
!   tmp = gfc_call_free (cfi_desc_ptr);
!   gfc_add_expr_to_block (&block, tmp);
!   tmp = build3_v (COND_EXPR, cond,
! 		  gfc_finish_block (&block),
! 		  build_empty_stmt (input_location));
!   gfc_prepend_expr_to_block (&parmse->post, tmp);
  
!   /* Transfer values back to gfc descriptor.  */
    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_conv_procedure_call (gfc_se * se, gf
*** 5516,5526 ****
  		}
  
  	      else if (sym->attr.is_bind_c && e
! 		       && ((fsym && fsym->attr.dimension
! 			    && (fsym->attr.pointer
! 				|| fsym->attr.allocatable
! 				|| fsym->as->type == AS_ASSUMED_RANK
! 				|| fsym->as->type == AS_ASSUMED_SHAPE))
  			   || non_unity_length_string))
  		/* Implement F2018, C.12.6.1: paragraph (2).  */
  		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
--- 5466,5472 ----
  		}
  
  	      else if (sym->attr.is_bind_c && e
! 		       && (is_CFI_desc (fsym, NULL)
  			   || non_unity_length_string))
  		/* Implement F2018, C.12.6.1: paragraph (2).  */
  		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5965,5976 ****
  		}
  
  	      if (sym->attr.is_bind_c && e
! 		  && fsym && fsym->attr.dimension
! 		  && (fsym->attr.pointer
! 		      || fsym->attr.allocatable
! 		      || fsym->as->type == AS_ASSUMED_RANK
! 		      || fsym->as->type == AS_ASSUMED_SHAPE
! 		      || non_unity_length_string))
  		/* Implement F2018, C.12.6.1: paragraph (2).  */
  		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
  
--- 5911,5917 ----
  		}
  
  	      if (sym->attr.is_bind_c && e
! 		  && (is_CFI_desc (fsym, NULL) || non_unity_length_string))
  		/* Implement F2018, C.12.6.1: paragraph (2).  */
  		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
  
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c	(revision 270149)
--- gcc/fortran/trans.c	(working copy)
*************** get_array_span (tree type, tree decl)
*** 352,357 ****
--- 352,360 ----
        else
  	span = NULL_TREE;
      }
+   else if (TREE_CODE (decl) == INDIRECT_REF
+ 	   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+     span = gfc_conv_descriptor_span_get (decl);
    else
      span = NULL_TREE;
  
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(working copy)
*************** float section_c(int *std_case, CFI_cdesc
*** 105,111 ****
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind, size;
    float *ret_addr;
    float ans = 0.0;
  
--- 105,111 ----
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind;
    float *ret_addr;
    float ans = 0.0;
  
*************** float section_c(int *std_case, CFI_cdesc
*** 121,129 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 121,127 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** float section_c(int *std_case, CFI_cdesc
*** 143,151 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 141,147 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** int setpointer_c(CFI_cdesc_t * ptr, int
*** 191,205 ****
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int ierr;
  
!   ierr = CFI_is_contiguous(desc);
!   if (ierr)
      return 1;
    if (desc->rank)
!     ierr = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     ierr = 3;
!   return ierr;
  }
--- 187,201 ----
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int res;
  
!   res = CFI_is_contiguous(desc);
!   if (!res)
      return 1;
    if (desc->rank)
!     res = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     res = 3;
!   return res;
  }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(working copy)
*************** end subroutine test_CFI_address
*** 170,185 ****
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 0) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 0) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 0) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 0) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 0) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 0) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 0) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
--- 170,185 ----
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 1) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 1) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 1) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 1) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 1) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 1) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 1) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(working copy)
***************
*** 0 ****
--- 1,73 ----
+ /* Test the fix of PR89843.  */
+ 
+ /* Contributed by Reinhold Bader  <Bader@lrz.de> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ #include <stdio.h>
+ #include <stdbool.h>
+ 
+ void sa(CFI_cdesc_t *, int, int *);
+ 
+ void si(CFI_cdesc_t *this, int flag, int *status)
+ {
+   int value, sum;
+   bool err;
+   CFI_CDESC_T(1) that;
+   CFI_index_t lb[] = { 0, 0 };
+   CFI_index_t ub[] = { 4, 1 };
+   CFI_index_t st[] = { 2, 0 };
+   int chksum[] = { 9, 36, 38 };
+ 
+   if (flag == 1)
+     {
+       lb[0] = 0; lb[1] = 2;
+       ub[0] = 2; ub[1] = 2;
+       st[0] = 1; st[1] = 0;
+     }
+   else if (flag == 2)
+     {
+       lb[0] = 1; lb[1] = 0;
+       ub[0] = 1; ub[1] = 3;
+       st[0] = 0; st[1] = 1;
+     }
+ 
+   CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
+ 		CFI_type_float, 0, 1, NULL);
+ 
+   *status = CFI_section((CFI_cdesc_t *) &that, this, lb, ub, st);
+ 
+   if (*status != CFI_SUCCESS)
+     {
+       printf("FAIL C: status is %i\n",status);
+       return;
+     }
+ 
+   value = CFI_is_contiguous((CFI_cdesc_t *) &that);
+   err = ((flag == 0 && value != 0)
+ 	 || (flag == 1 && value != 1)
+ 	 || (flag == 2 && value != 0));
+ 
+   if (err)
+     {
+       printf("FAIL C: contiguity for flag value %i - is %i\n",flag, value);
+       *status = 10;
+       return;
+     }
+ 
+   sum = 0;
+   for (int i = 0; i < that.dim[0].extent; i++)
+     {
+       CFI_index_t idx[] = {i};
+       sum += (int)(*(float *)CFI_address ((CFI_cdesc_t *)&that, idx));
+     }
+ 
+   if (sum != chksum[flag])
+     {
+       printf ("FAIL C: check sum = %d(%d)\n", sum, chksum[flag]);
+       *status = 11;
+       return;
+     }
+ 
+     sa((CFI_cdesc_t *) &that, flag, status);
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(working copy)
***************
*** 0 ****
--- 1,99 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_10.c }
+ !
+ ! Test the fix of PR89843.
+ !
+ ! Contributed by Reinhold Bader  <Bader@lrz.de>
+ !
+ module mod_section_01
+   use, intrinsic :: iso_c_binding
+   implicit none
+   interface
+      subroutine si(this, flag, status) bind(c)
+        import :: c_float, c_int
+        real(c_float) :: this(:,:)
+        integer(c_int), value :: flag
+        integer(c_int) :: status
+      end subroutine si
+   end interface
+ contains
+   subroutine sa(this, flag, status) bind(c)
+     real(c_float) :: this(:)
+     integer(c_int), value :: flag
+     integer(c_int) :: status
+ 
+     status = 0
+ 
+     select case (flag)
+     case (0)
+        if (is_contiguous(this)) then
+           write(*,*) 'FAIL 1:'
+           status = status + 1
+        end if
+        if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 2:',size(this)
+           status = status + 1
+           goto 10
+        end if
+        if (maxval(abs(this - [ 1.0, 3.0, 5.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 3:',abs(this)
+           status = status + 1
+        end if
+   10   continue
+    case (1)
+       if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 4:',size(this)
+           status = status + 1
+           goto 20
+        end if
+        if (maxval(abs(this - [ 11.0, 12.0, 13.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 5:',this
+           status = status + 1
+        end if
+   20   continue
+    case (2)
+       if (size(this,1) /= 4) then
+           write(*,*) 'FAIL 6:',size(this)
+           status = status + 1
+           goto 30
+        end if
+       if (maxval(abs(this - [ 2.0, 7.0, 12.0, 17.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 7:',this
+           status = status + 1
+        end if
+   30   continue
+     end select
+ 
+ !    if (status == 0) then
+ !       write(*,*) 'OK'
+ !    end if
+   end subroutine sa
+ end module mod_section_01
+ 
+ program section_01
+   use mod_section_01
+   implicit none
+   real(c_float) :: v(5,4)
+   integer :: i
+   integer :: status
+ 
+   v = reshape( [ (real(i), i = 1, 20) ], [ 5, 4 ] )
+   call si(v, 0, status)
+   if (status .ne. 0) stop 1
+ 
+   call sa(v(1:5:2, 1), 0, status)
+   if (status .ne. 0) stop 2
+ 
+   call si(v, 1, status)
+   if (status .ne. 0) stop 3
+ 
+   call sa(v(1:3, 3), 1, status)
+   if (status .ne. 0) stop 4
+ 
+   call si(v, 2, status)
+   if (status .ne. 0) stop 5
+ 
+   call sa(v(2,1:4), 2, status)
+   if (status .ne. 0) stop 6
+ 
+ end program section_01
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.c	(working copy)
***************
*** 0 ****
--- 1,78 ----
+ /* Test the fix of PR89846.
+ 
+ Contributed by Reinhold Bader  <Bader@lrz.de>#include <stdio.h> */
+ 
+ #include <stdlib.h>
+ #include <stddef.h>
+ #include <stdio.h>
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ 
+ typedef struct
+ {
+   char n;
+   float r[2];
+ } t1;
+ 
+ typedef struct
+ {
+   long int i;
+   t1 t1;
+ } t2;
+ 
+ 
+ 
+ void ta0(CFI_cdesc_t *);
+ void ta1(CFI_cdesc_t *);
+ 
+ void ti(CFI_cdesc_t *this, int flag)
+ {
+   int status;
+   size_t dis;
+   CFI_CDESC_T(1) that;
+   t1 *ans;
+ 
+   switch (flag)
+     {
+     case 0:
+       dis = offsetof(t2, t1);
+       status = CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
+ 			     CFI_type_struct, sizeof(t1), 1, NULL);
+       if (status != CFI_SUCCESS)
+ 	{
+ 	  printf("FAIL 1 establish: nonzero status %i\n",status);
+           exit(1);
+ 	}
+       status = CFI_select_part((CFI_cdesc_t *) &that, this, dis, 0);
+       if (status != CFI_SUCCESS)
+ 	{
+ 	  printf("FAIL C1: nonzero status %i\n",status);
+ 	  exit(1);
+ 	}
+      break;
+ 
+     case 1:
+       dis = offsetof(t2, i);
+       status = CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
+ 			     CFI_type_long, 0, 1, NULL);
+       if (status != CFI_SUCCESS)
+ 	{
+ 	  printf("FAIL 2 establish: nonzero status %i\n",status);
+ 	  exit(1);
+ 	}
+       status = CFI_select_part((CFI_cdesc_t *) &that, this, dis, 0);
+       if (status != CFI_SUCCESS)
+ 	{
+ 	  printf("FAIL C2: nonzero status %i\n",status);
+ 	  exit(1);
+ 	}
+     }
+ 
+   if (CFI_is_contiguous((CFI_cdesc_t *) &that))
+     {
+       printf("FAIL C: contiguity for flag value %i - is %i\n",flag,
+ 	     CFI_is_contiguous((CFI_cdesc_t *) &that));
+     }
+ 
+   if (flag == 0) ta0((CFI_cdesc_t *) &that);
+   if (flag == 1) ta1((CFI_cdesc_t *) &that);
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_11.f90	(working copy)
***************
*** 0 ****
--- 1,81 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_11.c }
+ !
+ ! Test the fix of PR89846.
+ !
+ ! Contributed by Reinhold Bader  <Bader@lrz.de>
+ !
+ module mod_subobj_01
+   use, intrinsic :: iso_c_binding
+   implicit none
+   integer, parameter :: nelem = 5
+   type, bind(c) :: t1
+      character(c_char) :: n
+      real(c_float) :: r(2)
+   end type t1
+   type, bind(c) :: t2
+      integer(c_long) :: i
+      type(t1) :: t1
+   end type t2
+   interface
+      subroutine ti(this, flag) bind(c)
+        import :: t2, c_int
+        type(t2) :: this(:)
+        integer(c_int), value :: flag
+      end subroutine ti
+   end interface
+ contains
+   subroutine ta0(this) bind(c)
+     type(t1) :: this(:)
+     integer :: i, iw, status
+     status = 0
+     if (size(this) /= nelem) then
+        write(*,*) 'FAIL 1: ',size(this)
+        status = status + 1
+     end if
+     iw = 0
+     do i=1, nelem
+        if (this(i)%n /= char(i,c_char) .or. this(i)%r(1) /= real(i,c_float) .or. &
+             this(i)%r(2) /= real(i+1,c_float)) then
+           iw = iw + 1
+        end if
+     end do
+     if (iw > 0) then
+        write(*,*) 'FAIL 2: ' ,this
+        status = status + 1
+     end if
+     if (status /= 0) stop 1
+   end subroutine ta0
+   subroutine ta1(this) bind(c)
+     integer(c_long) :: this(:)
+     integer :: i, status
+     status = 0
+     if (size(this) /= nelem) then
+        write(*,*) 'FAIL 3: ',size(this)
+        status = status + 1
+     end if
+     if (maxval(abs(this - [ (int(i,c_long),i=1,nelem) ])) > 0) then
+        write(*,*) 'FAIL 4: ' ,this
+        status = status + 1
+     end if
+     if (status /= 0) stop 2
+   end subroutine ta1
+ end module mod_subobj_01
+ program subobj_01
+   use mod_subobj_01
+   implicit none
+   integer :: i
+ 
+   type(t2), allocatable :: o_t2(:)
+ 
+   allocate(o_t2(nelem))
+   do i=1, nelem
+      o_t2(i)%t1 = t1( char(i,c_char), [ real(i,c_float), real(i+1,c_float) ] )
+      o_t2(i)%i = int(i,c_long)
+   end do
+ 
+   call ti(o_t2,0)
+   call ti(o_t2,1)
+ 
+ end program subobj_01
+ 
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_3.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_3.f90	(working copy)
***************
*** 7,20 ****
    integer, dimension(2,2) :: src = reshape ([1,2,3,4], [2,2])
  
    allocate (actual, source = src)
-   ier = test1 (actual)
-   if (ier .ne. 0) stop 1
- ! C call is INTENT(IN). 'c_test' increments elements of 'src'.
-   if (any (actual .ne. src)) stop 2
  
!   ier = test2 (actual)
    if (ier .ne. 0) stop 1
- ! C call is INTENT(INOUT) 'c_test' increments elements of 'src'.
    if (any (actual .ne. src + 1)) stop 2
  
  contains
--- 7,15 ----
    integer, dimension(2,2) :: src = reshape ([1,2,3,4], [2,2])
  
    allocate (actual, source = src)
  
!   ier = test1 (actual)
    if (ier .ne. 0) stop 1
    if (any (actual .ne. src + 1)) stop 2
  
  contains
*************** contains
*** 22,43 ****
    function test1 (arg) RESULT(err)
      USE, INTRINSIC :: ISO_C_BINDING
      INTEGER(C_INT) :: err
-     type(*), dimension(..), intent(inOUT) :: arg
-     interface
-       function test_c (a) BIND(C, NAME="c_test") RESULT(err)
-           USE, INTRINSIC :: ISO_C_BINDING
-           type(*), dimension(..), intent(in) :: a
-           INTEGER(C_INT) :: err
-       end function
-     end interface
- 
-     err = test_c (arg) ! This used to ICE
- 
-   end function test1
- 
-   function test2 (arg) RESULT(err)
-     USE, INTRINSIC :: ISO_C_BINDING
-     INTEGER(C_INT) :: err
      type(*), dimension(..), intent(inout) :: arg
      interface
        function test_c (a) BIND(C, NAME="c_test") RESULT(err)
--- 17,22 ----
*************** contains
*** 49,53 ****
  
      err = test_c (arg) ! This used to ICE
  
!   end function test2
  end
--- 28,32 ----
  
      err = test_c (arg) ! This used to ICE
  
!   end function test1
  end
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(working copy)
*************** contains
*** 10,18 ****
--- 10,20 ----
  
      if (any(abs(x - [2.,4.,6.]) > 1.e-6)) then
         write(*,*) 'FAIL'
+        stop 1
      else
         write(*,*) 'OK'
      end if
+     x = [2.,4.,6.]*10.0
    end subroutine
  end module
  program p
*************** program p
*** 23,27 ****
  
    x = [ (real(i), i=1, size(x)) ]
    call ctg(x(2::2))
! 
  end program
--- 25,29 ----
  
    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 2
  end program
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(working copy)
***************
*** 0 ****
--- 1,14 ----
+ /* Test fix of a problem with CFI_is_contiguous.  */
+ 
+ /* Contributed by Gilles Gouaillardet  <gilles@rist.or.jp> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ 
+ int cdesc_c(CFI_cdesc_t* x, long *expected)
+ {
+   int res;
+   res = CFI_is_contiguous (x);
+   if (x->base_addr != (void *)*expected) res = 0;
+   return res;
+ }
\ No newline at end of file
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_9.c }
+ !
+ ! Fix a problem with CFI_is_contiguous
+ !
+ ! Contributed by Gilles Gouaillardet  <gilles@rist.or.jp>
+ !
+ module cdesc
+   interface
+   function cdesc_f08(buf, expected) result (res) BIND(C, name="cdesc_c")
+       USE, INTRINSIC :: ISO_C_BINDING
+       implicit none
+       INTEGER(C_INT) :: res
+       type(*), dimension(..), INTENT(IN) :: buf
+       integer(kind=kind(loc(res))),INTENT(IN) :: expected
+     end function cdesc_f08
+   end interface
+ end module
+ 
+ program cdesc_test
+   use cdesc
+   implicit none
+   integer :: a0, a1(10), a2(10,10), a3(10,10,10)
+   if (cdesc_f08(a0, LOC(a0)) .ne. 1) stop 1
+   if (cdesc_f08(a1, LOC(a1(1))) .ne. 1) stop 2
+   if (cdesc_f08(a2, LOC(a2(1,1))) .ne. 1) stop 3
+   if (cdesc_f08(a3, LOC(a3(1,1,1))) .ne. 1) stop 4
+ end program
Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
*** libgfortran/runtime/ISO_Fortran_binding.c	(revision 270149)
--- libgfortran/runtime/ISO_Fortran_binding.c	(working copy)
*************** void
*** 37,59 ****
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
    CFI_cdesc_t *s = *s_ptr;
  
!   /* If not a full pointer or allocatable array free the descriptor
!      and return.  */
!   if (!s || s->attribute == CFI_attribute_other)
!     goto finish;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
- 
-   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
-     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
-   else
-     GFC_DESCRIPTOR_SIZE (d) =  (index_type)s->dim[0].sm;
- 
-   d->dtype.version = s->version;
-   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
--- 37,51 ----
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
+   index_type kind;
    CFI_cdesc_t *s = *s_ptr;
  
!   if (!s)
!     return;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
+   kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 61,72 ****
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
!     d->span = (index_type)s->dim[0].sm;
  
-   /* On the other hand, CFI_establish can change the bounds.  */
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
--- 53,78 ----
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
+   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+   else if (GFC_DESCRIPTOR_TYPE (d) != BT_DERIVED)
+     GFC_DESCRIPTOR_SIZE (d) = kind;
+   else
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+ 
+   d->dtype.version = s->version;
+   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
+ 
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
!     {
!       if ((size_t)s->dim[0].sm % s->elem_len)
! 	d->span = (index_type)s->dim[0].sm;
!       else
! 	d->span = (index_type)s->elem_len;
!     }
  
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 76,86 ****
        GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len);
        d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n);
      }
- 
- finish:
-   if (s)
-     free (s);
-   s = NULL;
  }
  
  extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
--- 82,87 ----
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 95,102 ****
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
--- 96,106 ----
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   if (*d_ptr == NULL)
!     d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
+   else
+     d = *d_ptr;
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 115,121 ****
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays have zero lower_bound.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
--- 119,125 ----
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays retain their lower_bounds.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 134,140 ****
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
--- 138,145 ----
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   if (*d_ptr == NULL)
!     *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 416,422 ****
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return CFI_INVALID_DESCRIPTOR;
  	}
  
        /* Base address must not be NULL. */
--- 421,427 ----
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return 0;
  	}
  
        /* Base address must not be NULL. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 424,430 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return CFI_ERROR_BASE_ADDR_NULL;
  	}
  
        /* Must be an array. */
--- 429,435 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return 0;
  	}
  
        /* Must be an array. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 432,444 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return CFI_INVALID_RANK;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return CFI_SUCCESS;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
--- 437,449 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return 0;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return 1;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 447,461 ****
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->elem_len
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return CFI_FAILURE;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return CFI_SUCCESS;
  }
  
  
--- 452,466 ----
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->dim[i - 1].sm
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return 0;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return 1;
  }
  
  
*************** int CFI_section (CFI_cdesc_t *result, co
*** 670,676 ****
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = upper[i] - lower[i] + 1;
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;
--- 675,681 ----
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = 1 + (upper[i] - lower[i])/stride[i];
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;
Thomas Koenig April 14, 2019, 5:08 p.m. | #9
Hi Paul,


> Please find attached the updated patch, which fixes the problem with

> -m32 in PR90022, eliminates the temporary creation for INTENT(IN)

> dummies and fixes PR89846.

> 

> While it looks like it should be intrusive because of its size, I

> believe that the patch is still safe for trunk since it is hidden

> behind tests for CFI descriptors.

> 

> Bootstraps and regtests on FC29/x86_64 - OK for trunk?


OK.

I we're going into the gcc 9 release with an implementation of the
C interop features, it will be better with fewer bugs :-)

Thanks a lot for working on it!

Regards

	Thomas
Paul Richard Thomas April 14, 2019, 6:16 p.m. | #10
Hi Thomas,

Thanks a lot. Committed as revision 270353.

I was determined not to repeat the PDT experience, which is still
nagging at me. That has to be the next major gfc project, I guess.

Regards

Paul

On Sun, 14 Apr 2019 at 18:08, Thomas Koenig <tkoenig@netcologne.de> wrote:
>

> Hi Paul,

>

>

> > Please find attached the updated patch, which fixes the problem with

> > -m32 in PR90022, eliminates the temporary creation for INTENT(IN)

> > dummies and fixes PR89846.

> >

> > While it looks like it should be intrusive because of its size, I

> > believe that the patch is still safe for trunk since it is hidden

> > behind tests for CFI descriptors.

> >

> > Bootstraps and regtests on FC29/x86_64 - OK for trunk?

>

> OK.

>

> I we're going into the gcc 9 release with an implementation of the

> C interop features, it will be better with fewer bugs :-)

>

> Thanks a lot for working on it!

>

> Regards

>

>         Thomas




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Bader, Reinhold April 15, 2019, 9:27 a.m. | #11
Dear Paul, 

mostly looks good. Apart from a regression with optional arguments reported as
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=90093 
all other  test cases I have now execute correctly.

Cheers
Reinhold

> -----Ursprüngliche Nachricht-----

> Von: Paul Richard Thomas <paul.richard.thomas@gmail.com>

> Gesendet: Sonntag, 14. April 2019 20:16

> An: Thomas Koenig <tkoenig@netcologne.de>

> Cc: Gilles Gouaillardet <gilles@rist.or.jp>; Bader, Reinhold

> <Reinhold.Bader@lrz.de>; fortran@gcc.gnu.org; gcc-patches <gcc-

> patches@gcc.gnu.org>

> Betreff: Re: [Patch, fortran] PRs 89843 and 90022 - C Fortran Interop fixes.

> 

> Hi Thomas,

> 

> Thanks a lot. Committed as revision 270353.

> 

> I was determined not to repeat the PDT experience, which is still nagging at

> me. That has to be the next major gfc project, I guess.

> 

> Regards

> 

> Paul

> 

> On Sun, 14 Apr 2019 at 18:08, Thomas Koenig <tkoenig@netcologne.de>

> wrote:

> >

> > Hi Paul,

> >

> >

> > > Please find attached the updated patch, which fixes the problem with

> > > -m32 in PR90022, eliminates the temporary creation for INTENT(IN)

> > > dummies and fixes PR89846.

> > >

> > > While it looks like it should be intrusive because of its size, I

> > > believe that the patch is still safe for trunk since it is hidden

> > > behind tests for CFI descriptors.

> > >

> > > Bootstraps and regtests on FC29/x86_64 - OK for trunk?

> >

> > OK.

> >

> > I we're going into the gcc 9 release with an implementation of the C

> > interop features, it will be better with fewer bugs :-)

> >

> > Thanks a lot for working on it!

> >

> > Regards

> >

> >         Thomas

> 

> 

> 

> --

> "If you can't explain it simply, you don't understand it well enough"

> - Albert Einstein
Paul Richard Thomas April 15, 2019, 12:06 p.m. | #12
Dear Dominique, Gilles and Reinhold,

Thank you for your rapid feedback. We might even get a reasonably
functional ISO Fortran binding in place for 9-branch release :-)  On
your remaining nits:

(i) ISO_Fortran_binding_4.f90 -m32 -O1/Os looks awful. I will take a
look, though.

(ii) pr89844 being fixed by an earlier patch led me to give it lower
priority. I will look to see whether another testcase is required to
nail it down.

(iii) I will take a look at 90093 - it should be straight forward. I
do not regard it as being a regression, however, since the arguments
were not being correctly handled until now - ie. were not converted
from cfi to gfc descriptors.

Cheers

Paul

On Mon, 15 Apr 2019 at 10:27, Bader, Reinhold <Reinhold.Bader@lrz.de> wrote:
>

> Dear Paul,

>

> mostly looks good. Apart from a regression with optional arguments reported as

> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=90093

> all other  test cases I have now execute correctly.

>

> Cheers

> Reinhold

>

> > -----Ursprüngliche Nachricht-----

> > Von: Paul Richard Thomas <paul.richard.thomas@gmail.com>

> > Gesendet: Sonntag, 14. April 2019 20:16

> > An: Thomas Koenig <tkoenig@netcologne.de>

> > Cc: Gilles Gouaillardet <gilles@rist.or.jp>; Bader, Reinhold

> > <Reinhold.Bader@lrz.de>; fortran@gcc.gnu.org; gcc-patches <gcc-

> > patches@gcc.gnu.org>

> > Betreff: Re: [Patch, fortran] PRs 89843 and 90022 - C Fortran Interop fixes.

> >

> > Hi Thomas,

> >

> > Thanks a lot. Committed as revision 270353.

> >

> > I was determined not to repeat the PDT experience, which is still nagging at

> > me. That has to be the next major gfc project, I guess.

> >

> > Regards

> >

> > Paul

> >

> > On Sun, 14 Apr 2019 at 18:08, Thomas Koenig <tkoenig@netcologne.de>

> > wrote:

> > >

> > > Hi Paul,

> > >

> > >

> > > > Please find attached the updated patch, which fixes the problem with

> > > > -m32 in PR90022, eliminates the temporary creation for INTENT(IN)

> > > > dummies and fixes PR89846.

> > > >

> > > > While it looks like it should be intrusive because of its size, I

> > > > believe that the patch is still safe for trunk since it is hidden

> > > > behind tests for CFI descriptors.

> > > >

> > > > Bootstraps and regtests on FC29/x86_64 - OK for trunk?

> > >

> > > OK.

> > >

> > > I we're going into the gcc 9 release with an implementation of the C

> > > interop features, it will be better with fewer bugs :-)

> > >

> > > Thanks a lot for working on it!

> > >

> > > Regards

> > >

> > >         Thomas

> >

> >

> >

> > --

> > "If you can't explain it simply, you don't understand it well enough"

> > - Albert Einstein




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 270149)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1494,1499 ****
--- 1494,1506 ----
        && sym->attr.dummy)
      gfc_defer_symbol_init (sym);
  
+   if (sym->attr.dummy
+       && sym->ns->proc_name->attr.is_bind_c
+       && sym->attr.dimension
+       && (sym->as->type == AS_ASSUMED_SHAPE
+ 	  || sym->as->type == AS_ASSUMED_RANK))
+     gfc_defer_symbol_init (sym);
+ 
    /* All deferred character length procedures need to retain the backend
       decl, which is a pointer to the character length in the caller's
       namespace and to declare a local character length.  */
*************** gfc_null_and_pass_deferred_len (gfc_symb
*** 4268,4273 ****
--- 4275,4353 ----
  }
  
  
+ /* 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 incoming;
+   tree outgoing;
+   stmtblock_t tmpblock;
+ 
+   /* dummy_ptr will be the pointer to the passed array descriptor,
+      while CFI_desc is the descriptor itself.  */
+   dummy_ptr = sym->backend_decl;
+   CFI_desc = sym->backend_decl;
+   if (POINTER_TYPE_P (TREE_TYPE (CFI_desc)))
+     CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
+   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (CFI_desc)))
+     {
+       if (DECL_LANG_SPECIFIC (sym->backend_decl))
+ 	CFI_desc = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
+       else
+ 	CFI_desc = NULL;
+       dummy_ptr = CFI_desc;
+     }
+ 
+   if (CFI_desc)
+     {
+       if (POINTER_TYPE_P (TREE_TYPE (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");
+ 
+       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));
+       incoming = gfc_finish_block (&tmpblock);
+ 
+       gfc_init_block (&tmpblock);
+       /* Convert the gfc descriptor back to the CFI type before going
+ 	 out of scope.  */
+       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 = gfc_finish_block (&tmpblock);
+ 
+       /* 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
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4844,4849 ****
--- 4924,4940 ----
  	}
        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 (sym->attr.dummy
+ 	  && sym->ns->proc_name->attr.is_bind_c
+ 	  && sym->attr.dimension
+ 	  && (sym->as->type == AS_ASSUMED_SHAPE
+ 	      || sym->as->type == AS_ASSUMED_RANK))
+ 	convert_CFI_desc (block, sym);
      }
  
    gfc_init_block (&tmpblock);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 270149)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 4990,4997 ****
--- 4990,4999 ----
    tree ptr = NULL_TREE;
    tree size;
    tree type;
+   tree cond;
    int attribute;
    symbol_attribute attr = gfc_expr_attr (e);
+   stmtblock_t block;
  
    /* If this is a full array or a scalar, the allocatable and pointer
       attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5135,5140 ****
--- 5137,5144 ----
    /* Variables to point to the gfc and CFI descriptors.  */
    gfc_desc_ptr = parmse->expr;
    cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
+   gfc_add_modify (&parmse->pre, cfi_desc_ptr,
+ 		  build_int_cst (pvoid_type_node, 0));
  
    /* Allocate the CFI descriptor and fill the fields.  */
    tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5147,5154 ****
  
    if (ptr)
      {
!       /* Free both the temporary data and the CFI descriptor for
! 	 INTENT(IN) arrays.  */
        tmp = gfc_call_free (ptr);
        gfc_prepend_expr_to_block (&parmse->post, tmp);
        tmp = gfc_call_free (cfi_desc_ptr);
--- 5151,5157 ----
  
    if (ptr)
      {
!       /* Free the temporary data for INTENT(IN) arrays.  */
        tmp = gfc_call_free (ptr);
        gfc_prepend_expr_to_block (&parmse->post, tmp);
        tmp = gfc_call_free (cfi_desc_ptr);
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5156,5162 ****
        return;
      }
  
!   /* Transfer values back to gfc descriptor and free the CFI descriptor.  */
    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);
--- 5159,5177 ----
        return;
      }
  
!   /* Free the CFI descriptor.  */
!   gfc_init_block (&block);
!   cond = fold_build2_loc (input_location, NE_EXPR,
! 			  logical_type_node, cfi_desc_ptr,
! 			  build_int_cst (TREE_TYPE (cfi_desc_ptr), 0));
!   tmp = gfc_call_free (cfi_desc_ptr);
!   gfc_add_expr_to_block (&block, tmp);
!   tmp = build3_v (COND_EXPR, cond,
! 		  gfc_finish_block (&block),
! 		  build_empty_stmt (input_location));
!   gfc_prepend_expr_to_block (&parmse->post, tmp);
! 
!   /* Transfer values back to gfc descriptor.  */
    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);
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(working copy)
*************** float section_c(int *std_case, CFI_cdesc
*** 105,111 ****
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind, size;
    float *ret_addr;
    float ans = 0.0;
  
--- 105,111 ----
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind;
    float *ret_addr;
    float ans = 0.0;
  
*************** float section_c(int *std_case, CFI_cdesc
*** 121,129 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 121,127 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** float section_c(int *std_case, CFI_cdesc
*** 143,151 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 141,147 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** int setpointer_c(CFI_cdesc_t * ptr, int
*** 191,205 ****
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int ierr;
  
!   ierr = CFI_is_contiguous(desc);
!   if (ierr)
      return 1;
    if (desc->rank)
!     ierr = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     ierr = 3;
!   return ierr;
  }
--- 187,201 ----
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int res;
  
!   res = CFI_is_contiguous(desc);
!   if (!res)
      return 1;
    if (desc->rank)
!     res = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     res = 3;
!   return res;
  }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(working copy)
*************** end subroutine test_CFI_address
*** 170,185 ****
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 0) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 0) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 0) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 0) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 0) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 0) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 0) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
--- 170,185 ----
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 1) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 1) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 1) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 1) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 1) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 1) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 1) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(working copy)
***************
*** 0 ****
--- 1,73 ----
+ /* Test the fix of PR89843.  */
+ 
+ /* Contributed by Reinhold Bader  <Bader@lrz.de> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ #include <stdio.h>
+ #include <stdbool.h>
+ 
+ void sa(CFI_cdesc_t *, int, int *);
+ 
+ void si(CFI_cdesc_t *this, int flag, int *status)
+ {
+   int value, sum;
+   bool err;
+   CFI_CDESC_T(1) that;
+   CFI_index_t lb[] = { 0, 0 };
+   CFI_index_t ub[] = { 4, 1 };
+   CFI_index_t st[] = { 2, 0 };
+   int chksum[] = { 9, 36, 38 };
+ 
+   if (flag == 1)
+     {
+       lb[0] = 0; lb[1] = 2;
+       ub[0] = 2; ub[1] = 2;
+       st[0] = 1; st[1] = 0;
+     }
+   else if (flag == 2)
+     {
+       lb[0] = 1; lb[1] = 0;
+       ub[0] = 1; ub[1] = 3;
+       st[0] = 0; st[1] = 1;
+     }
+ 
+   CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
+ 		CFI_type_float, 0, 1, NULL);
+ 
+   *status = CFI_section((CFI_cdesc_t *) &that, this, lb, ub, st);
+ 
+   if (*status != CFI_SUCCESS)
+     {
+       printf("FAIL C: status is %i\n",status);
+       return;
+     }
+ 
+   value = CFI_is_contiguous((CFI_cdesc_t *) &that);
+   err = ((flag == 0 && value != 0)
+ 	 || (flag == 1 && value != 1)
+ 	 || (flag == 2 && value != 0));
+ 
+   if (err)
+     {
+       printf("FAIL C: contiguity for flag value %i - is %i\n",flag, value);
+       *status = 10;
+       return;
+     }
+ 
+   sum = 0;
+   for (int i = 0; i < that.dim[0].extent; i++)
+     {
+       CFI_index_t idx[] = {i};
+       sum += (int)(*(float *)CFI_address ((CFI_cdesc_t *)&that, idx));
+     }
+ 
+   if (sum != chksum[flag])
+     {
+       printf ("FAIL C: check sum = %d(%d)\n", sum, chksum[flag]);
+       *status = 11;
+       return;
+     }
+ 
+     sa((CFI_cdesc_t *) &that, flag, status);
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(working copy)
***************
*** 0 ****
--- 1,99 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_10.c }
+ !
+ ! Test the fix of PR89843.
+ !
+ ! Contributed by Reinhold Bader  <Bader@lrz.de>
+ !
+ module mod_section_01
+   use, intrinsic :: iso_c_binding
+   implicit none
+   interface
+      subroutine si(this, flag, status) bind(c)
+        import :: c_float, c_int
+        real(c_float) :: this(:,:)
+        integer(c_int), value :: flag
+        integer(c_int) :: status
+      end subroutine si
+   end interface
+ contains
+   subroutine sa(this, flag, status) bind(c)
+     real(c_float) :: this(:)
+     integer(c_int), value :: flag
+     integer(c_int) :: status
+ 
+     status = 0
+ 
+     select case (flag)
+     case (0)
+        if (is_contiguous(this)) then
+           write(*,*) 'FAIL 1:'
+           status = status + 1
+        end if
+        if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 2:',size(this)
+           status = status + 1
+           goto 10
+        end if
+        if (maxval(abs(this - [ 1.0, 3.0, 5.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 3:',this
+           status = status + 1
+        end if
+   10   continue
+    case (1)
+       if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 4:',size(this)
+           status = status + 1
+           goto 20
+        end if
+        if (maxval(abs(this - [ 11.0, 12.0, 13.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 5:',this
+           status = status + 1
+        end if
+   20   continue
+    case (2)
+       if (size(this,1) /= 4) then
+           write(*,*) 'FAIL 6:',size(this)
+           status = status + 1
+           goto 30
+        end if
+       if (maxval(abs(this - [ 2.0, 7.0, 12.0, 17.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 7:',this
+           status = status + 1
+        end if
+   30   continue
+     end select
+ 
+ !    if (status == 0) then
+ !       write(*,*) 'OK'
+ !    end if
+   end subroutine sa
+ end module mod_section_01
+ 
+ program section_01
+   use mod_section_01
+   implicit none
+   real(c_float) :: v(5,4)
+   integer :: i
+   integer :: status
+ 
+   v = reshape( [ (real(i), i = 1, 20) ], [ 5, 4 ] )
+   call si(v, 0, status)
+   if (status .ne. 0) stop 1
+ 
+   call sa(v(1:5:2, 1), 0, status)
+   if (status .ne. 0) stop 2
+ 
+   call si(v, 1, status)
+   if (status .ne. 0) stop 3
+ 
+   call sa(v(1:3, 3), 1, status)
+   if (status .ne. 0) stop 4
+ 
+   call si(v, 2, status)
+   if (status .ne. 0) stop 5
+ 
+   call sa(v(2,1:4), 2, status)
+   if (status .ne. 0) stop 6
+ 
+ end program section_01
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(working copy)
*************** contains
*** 10,18 ****
--- 10,20 ----
  
      if (any(abs(x - [2.,4.,6.]) > 1.e-6)) then
         write(*,*) 'FAIL'
+        stop 1
      else
         write(*,*) 'OK'
      end if
+     x = [2.,4.,6.]*10.0
    end subroutine
  end module
  program p
*************** program p
*** 23,27 ****
  
    x = [ (real(i), i=1, size(x)) ]
    call ctg(x(2::2))
! 
  end program
--- 25,29 ----
  
    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 2
  end program
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(working copy)
***************
*** 0 ****
--- 1,14 ----
+ /* Test fix of a problem with CFI_is_contiguous.  */
+ 
+ /* Contributed by Gilles Gouaillardet  <gilles@rist.or.jp> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ 
+ int cdesc_c(CFI_cdesc_t* x, long *expected)
+ {
+   int res;
+   res = CFI_is_contiguous (x);
+   if (x->base_addr != (void *)*expected) res = 0;
+   return res;
+ }
\ No newline at end of file
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_9.c }
+ !
+ ! Fix a problem with CFI_is_contiguous
+ !
+ ! Contributed by Gilles Gouaillardet  <gilles@rist.or.jp>
+ !
+ module cdesc
+   interface
+   function cdesc_f08(buf, expected) result (res) BIND(C, name="cdesc_c")
+       USE, INTRINSIC :: ISO_C_BINDING
+       implicit none
+       INTEGER(C_INT) :: res
+       type(*), dimension(..), INTENT(INOUT) :: buf
+       integer(kind=8),INTENT(IN) :: expected
+     end function cdesc_f08
+   end interface
+ end module
+ 
+ program cdesc_test
+   use cdesc
+   implicit none
+   integer :: a0, a1(10), a2(10,10), a3(10,10,10)
+   if (cdesc_f08(a0, LOC(a0)) .ne. 1) stop 1
+   if (cdesc_f08(a1, LOC(a1(1))) .ne. 1) stop 2
+   if (cdesc_f08(a2, LOC(a2(1,1))) .ne. 1) stop 3
+   if (cdesc_f08(a3, LOC(a3(1,1,1))) .ne. 1) stop 4
+ end program
Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
*** libgfortran/runtime/ISO_Fortran_binding.c	(revision 270149)
--- libgfortran/runtime/ISO_Fortran_binding.c	(working copy)
*************** void
*** 37,59 ****
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
    CFI_cdesc_t *s = *s_ptr;
  
!   /* If not a full pointer or allocatable array free the descriptor
!      and return.  */
!   if (!s || s->attribute == CFI_attribute_other)
!     goto finish;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
- 
-   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
-     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
-   else
-     GFC_DESCRIPTOR_SIZE (d) =  (index_type)s->dim[0].sm;
- 
-   d->dtype.version = s->version;
-   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
--- 37,51 ----
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
+   index_type kind;
    CFI_cdesc_t *s = *s_ptr;
  
!   if (!s)
!     return;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
+   kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 61,72 ****
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
      d->span = (index_type)s->dim[0].sm;
  
-   /* On the other hand, CFI_establish can change the bounds.  */
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
--- 53,73 ----
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
+   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+   else if (GFC_DESCRIPTOR_TYPE (d) != BT_DERIVED)
+     GFC_DESCRIPTOR_SIZE (d) = kind;
+   else
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+ 
+   d->dtype.version = s->version;
+   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
+ 
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
      d->span = (index_type)s->dim[0].sm;
  
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 76,86 ****
        GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len);
        d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n);
      }
- 
- finish:
-   if (s)
-     free (s);
-   s = NULL;
  }
  
  extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
--- 77,82 ----
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 95,102 ****
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
--- 91,101 ----
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   if (*d_ptr == NULL)
!     d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
+   else
+     d = *d_ptr;
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 115,121 ****
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays have zero lower_bound.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
--- 114,120 ----
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays retain their lower_bounds.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 134,140 ****
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
--- 133,140 ----
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   if (*d_ptr == NULL)
!     *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 416,422 ****
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return CFI_INVALID_DESCRIPTOR;
  	}
  
        /* Base address must not be NULL. */
--- 416,422 ----
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return 0;
  	}
  
        /* Base address must not be NULL. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 424,430 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return CFI_ERROR_BASE_ADDR_NULL;
  	}
  
        /* Must be an array. */
--- 424,430 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return 0;
  	}
  
        /* Must be an array. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 432,444 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return CFI_INVALID_RANK;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return CFI_SUCCESS;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
--- 432,444 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return 0;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return 1;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 447,461 ****
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->elem_len
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return CFI_FAILURE;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return CFI_SUCCESS;
  }
  
  
--- 447,461 ----
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->dim[i - 1].sm
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return 0;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return 1;
  }
  
  
*************** int CFI_section (CFI_cdesc_t *result, co
*** 670,676 ****
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = upper[i] - lower[i] + 1;
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;
--- 670,676 ----
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = 1 + (upper[i] - lower[i])/stride[i];
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;