* [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling @ 2021-06-14 23:09 José Rui Faustino de Sousa 2021-06-21 13:46 ` Tobias Burnus 0 siblings, 1 reply; 9+ messages in thread From: José Rui Faustino de Sousa @ 2021-06-14 23:09 UTC (permalink / raw) To: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 2322 bytes --] Hi all! Update to a proposed patch to: Bug 93308 - bind(c) subroutine changes lower bound of array argument in caller Bug 93963 - Select rank mishandling allocatable and pointer arguments with bind(c) Bug 94327 - Bind(c) argument attributes are incorrectly set Bug 94331 - Bind(C) corrupts array descriptors Bug 97046 - Bad interaction between lbound/ubound, allocatable arrays and bind(C) subroutine with dimension(..) parameter due to errors found in one of the tests by Dominique d'Humieres. Patch tested only on x86_64-pc-linux-gnu. Fix attribute handling, which reflect a prior intermediate version of the Fortran standard. CFI descriptors, in most cases, should not be copied out has they can corrupt the Fortran descriptor. Bounds will vary and the original Fortran bounds are definitively lost on conversion. Thank you very much. Best regards, José Rui Fortran: Fix attributtes and bounds in ISO_Fortran_binding. gcc/fortran/ChangeLog: PR fortran/93308 PR fortran/93963 PR fortran/94327 PR fortran/94331 PR fortran/97046 * trans-decl.c (convert_CFI_desc): Only copy out the descriptor if necessary. * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute handling which reflect a previous intermediate version of the standard. Only copy out the descriptor if necessary. libgfortran/ChangeLog: PR fortran/93308 PR fortran/93963 PR fortran/94327 PR fortran/94331 PR fortran/97046 * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code to verify the descriptor. Correct bounds calculation. (gfc_desc_to_cfi_desc): Add code to verify the descriptor. gcc/testsuite/ChangeLog: PR fortran/93308 PR fortran/93963 PR fortran/94327 PR fortran/94331 PR fortran/97046 * gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute, this test is still erroneous but now it compiles. * gfortran.dg/bind_c_array_params_2.f90: Update regex to match code changes. * gfortran.dg/PR93308.f90: New test. * gfortran.dg/PR93963.f90: New test. * gfortran.dg/PR94327.c: New test. * gfortran.dg/PR94327.f90: New test. * gfortran.dg/PR94331.c: New test. * gfortran.dg/PR94331.f90: New test. * gfortran.dg/PR97046.f90: New test. [-- Attachment #2: PR93308-93963-94327-94331-97046.patch --] [-- Type: text/x-patch, Size: 32092 bytes --] diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c32bd05..97aafe3 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4526,22 +4526,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym) gfc_add_expr_to_block (&outer_block, incoming); incoming = gfc_finish_block (&outer_block); - /* Convert the gfc descriptor back to the CFI type before going out of scope, if the CFI type was present at entry. */ - gfc_init_block (&outer_block); - gfc_init_block (&tmpblock); - - tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); - outgoing = build_call_expr_loc (input_location, - gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); - gfc_add_expr_to_block (&tmpblock, outgoing); + outgoing = NULL_TREE; + if ((sym->attr.pointer || sym->attr.allocatable) + && !sym->attr.value + && sym->attr.intent != INTENT_IN) + { + gfc_init_block (&outer_block); + gfc_init_block (&tmpblock); - outgoing = build3_v (COND_EXPR, present, - gfc_finish_block (&tmpblock), - build_empty_stmt (input_location)); - gfc_add_expr_to_block (&outer_block, outgoing); - outgoing = gfc_finish_block (&outer_block); + tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); + outgoing = build_call_expr_loc (input_location, + gfor_fndecl_gfc_to_cfi, 2, + tmp, gfc_desc_ptr); + gfc_add_expr_to_block (&tmpblock, outgoing); + + outgoing = build3_v (COND_EXPR, present, + gfc_finish_block (&tmpblock), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&outer_block, outgoing); + outgoing = gfc_finish_block (&outer_block); + } /* Add the lot to the procedure init and finally blocks. */ gfc_add_init_cleanup (block, incoming, outgoing); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index de406ad..52e243b 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5501,13 +5501,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) attribute = 1; } - /* If the formal argument is assumed shape and neither a pointer nor - allocatable, it is unconditionally CFI_attribute_other. */ - if (fsym->as->type == AS_ASSUMED_SHAPE - && !fsym->attr.pointer && !fsym->attr.allocatable) - cfi_attribute = 2; + if (fsym->attr.pointer) + cfi_attribute = 0; + else if (fsym->attr.allocatable) + cfi_attribute = 1; else - cfi_attribute = attribute; + cfi_attribute = 2; if (e->rank != 0) { @@ -5615,10 +5614,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) 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_prepend_expr_to_block (&parmse->post, tmp); + if (cfi_attribute != 2 + && !fsym->attr.value + && fsym->attr.intent != INTENT_IN) + { + tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp); + gfc_prepend_expr_to_block (&parmse->post, tmp); + } /* Deal with an optional dummy being passed to an optional formal arg by finishing the pre and post blocks and making their execution diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 index 102bc60..0cf3b2c 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 @@ -39,7 +39,7 @@ USE, INTRINSIC :: ISO_C_BINDING import INTEGER(C_INT) :: err - type (T), DIMENSION(..), intent(out) :: a + type (T), pointer, DIMENSION(..), intent(out) :: a END FUNCTION c_establish FUNCTION c_contiguous(a) BIND(C, NAME="contiguous_c") RESULT(err) diff --git a/gcc/testsuite/gfortran.dg/PR93308.f90 b/gcc/testsuite/gfortran.dg/PR93308.f90 new file mode 100644 index 0000000..ee116f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR93308.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! +! Test the fix for PR94331 +! +! Contributed by Robin Hogan <r.j.hogan@reading.ac.uk> +! + +program test + + use, intrinsic :: iso_c_binding, only: & + c_int, c_float + + implicit none + + integer :: i + integer, parameter :: n = 11 + real(kind=c_float), parameter :: u(*) = [(real(i, kind=c_float), i=1,n)] + + real(kind=c_float), allocatable :: A(:) + real(kind=c_float) :: E(n) + integer(kind=c_int) :: l1, l2, l3 + + allocate(A, source=u) + l1 = lbound(A, 1) + call routine_bindc(A, l2) ! in gcc-9.2.1 this changes lbound of A... + l3 = lbound(A, 1) + if (l1 /= 1) stop 1 + if (l1 /= l2) stop 2 + if (l1 /= l3) stop 3 + if (any(abs(A(1:n)-u)>0.0_c_float)) stop 4 + deallocate(A) + ! + E = u + l1 = lbound(E, 1) + call routine_bindc(E, l2) ! ...but does not change lbound of E + l3 = lbound(E, 1) + if (l1 /= 1) stop 5 + if (l1 /= l2) stop 6 + if (l1 /= l3) stop 7 + if (any(abs(E(1:n)-u)>0.0_c_float)) stop 8 + +contains + + subroutine routine_bindc(v, l) bind(c) + real(kind=c_float), intent(inout) :: v(:) + integer(kind=c_int), intent(out) :: l + + l = lbound(v, 1) + if (any(abs(v(1:n)-u)>0.0_c_float)) stop 9 + end subroutine routine_bindc + +end program test diff --git a/gcc/testsuite/gfortran.dg/PR93963.f90 b/gcc/testsuite/gfortran.dg/PR93963.f90 new file mode 100644 index 0000000..4e1b06f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR93963.f90 @@ -0,0 +1,150 @@ +! { dg-do run } +! +! Test the fix for PR93963 +! + +function rank_p(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + integer(kind=c_int), pointer, intent(in) :: this(..) + integer(kind=c_int) :: rnk + + select rank(this) + rank(0) + rnk = 0 + rank(1) + rnk = 1 + rank(2) + rnk = 2 + rank(3) + rnk = 3 + rank(4) + rnk = 4 + rank(5) + rnk = 5 + rank(6) + rnk = 6 + rank(7) + rnk = 7 + rank(8) + rnk = 8 + rank(9) + rnk = 9 + rank(10) + rnk = 10 + rank(11) + rnk = 11 + rank(12) + rnk = 12 + rank(13) + rnk = 13 + rank(14) + rnk = 14 + rank(15) + rnk = 15 + rank default + rnk = -1000 + end select + return +end function rank_p + +function rank_a(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + integer(kind=c_int), allocatable, intent(in) :: this(..) + integer(kind=c_int) :: rnk + + select rank(this) + rank(0) + rnk = 0 + rank(1) + rnk = 1 + rank(2) + rnk = 2 + rank(3) + rnk = 3 + rank(4) + rnk = 4 + rank(5) + rnk = 5 + rank(6) + rnk = 6 + rank(7) + rnk = 7 + rank(8) + rnk = 8 + rank(9) + rnk = 9 + rank(10) + rnk = 10 + rank(11) + rnk = 11 + rank(12) + rnk = 12 + rank(13) + rnk = 13 + rank(14) + rnk = 14 + rank(15) + rnk = 15 + rank default + rnk = -1000 + end select + return +end function rank_a + +program selr_p + + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + interface + function rank_p(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + integer(kind=c_int), pointer, intent(in) :: this(..) + integer(kind=c_int) :: rnk + end function rank_p + end interface + + interface + function rank_a(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + integer(kind=c_int), allocatable, intent(in) :: this(..) + integer(kind=c_int) :: rnk + end function rank_a + end interface + + integer(kind=c_int), parameter :: siz = 7 + integer(kind=c_int), parameter :: rnk = 1 + + integer(kind=c_int), pointer :: intp(:) + integer(kind=c_int), allocatable :: inta(:) + integer(kind=c_int) :: irnk + + nullify(intp) + irnk = rank_p(intp) + if (irnk /= rnk) stop 1 + if (irnk /= rank(intp)) stop 2 + ! + irnk = rank_a(inta) + if (irnk /= rnk) stop 3 + if (irnk /= rank(inta)) stop 4 + ! + allocate(intp(siz)) + irnk = rank_p(intp) + if (irnk /= rnk) stop 5 + if (irnk /= rank(intp)) stop 6 + deallocate(intp) + nullify(intp) + ! + allocate(inta(siz)) + if (irnk /= rnk) stop 7 + if (irnk /= rank(inta)) stop 8 + deallocate(inta) + +end program selr_p diff --git a/gcc/testsuite/gfortran.dg/PR94327.c b/gcc/testsuite/gfortran.dg/PR94327.c new file mode 100644 index 0000000..6791c37 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94327.c @@ -0,0 +1,70 @@ +/* Test the fix for PR94327. */ + +#include <assert.h> +#include <stdbool.h> +#include <stdlib.h> + +#include "../../../libgfortran/ISO_Fortran_binding.h" + +bool c_vrfy (const CFI_cdesc_t *restrict); + +char get_attr (const CFI_cdesc_t*restrict, bool); + +bool +c_vrfy (const CFI_cdesc_t *restrict auxp) +{ + CFI_index_t i, lb, ub, ex; + int *ip = NULL; + + assert (auxp); + assert (auxp->base_addr); + lb = auxp->dim[0].lower_bound; + ex = auxp->dim[0].extent; + ub = ex + lb - 1; + ip = (int*)auxp->base_addr; + for (i=0; i<ex; i++) + if (*ip++ != i+1) + return false; + for (i=lb; i<ub+1; i++) + { + ip = (int*)CFI_address(auxp, &i); + if (*ip != i-lb+1) + return false; + } + return true; +} + +char +get_attr (const CFI_cdesc_t *restrict auxp, bool alloc) +{ + char attr; + + assert (auxp); + assert (auxp->elem_len == 4); + assert (auxp->rank == 1); + assert (auxp->type == CFI_type_int); + attr = '\0'; + switch (auxp->attribute) + { + case CFI_attribute_pointer: + if (alloc && !c_vrfy (auxp)) + break; + attr = 'p'; + break; + case CFI_attribute_allocatable: + if (alloc && !c_vrfy (auxp)) + break; + attr = 'a'; + break; + case CFI_attribute_other: + assert (alloc); + if (!c_vrfy (auxp)) + break; + attr = 'o'; + break; + default: + break; + } + return attr; +} + diff --git a/gcc/testsuite/gfortran.dg/PR94327.f90 b/gcc/testsuite/gfortran.dg/PR94327.f90 new file mode 100644 index 0000000..3cb3ac3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94327.f90 @@ -0,0 +1,195 @@ +! { dg-do run } +! { dg-additional-sources PR94327.c } +! +! Test the fix for PR94327 +! + +program attr_p + + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + + implicit none + + integer :: i + integer, parameter :: n = 11 + integer, parameter :: u(*) = [(i, i=1,n)] + + interface + function attr_p_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), pointer, intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_p_as + function attr_a_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_a_as + function attr_o_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_o_as + function attr_p_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), pointer, intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_p_ar + function attr_a_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_a_ar + function attr_o_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_o_ar + end interface + + integer(kind=c_int), target :: a(n) + integer(kind=c_int), allocatable, target :: b(:) + integer(kind=c_int), pointer :: p(:) + character(kind=c_char) :: c + + a = u + c = attr_p_as(a, .true._c_bool) + if(c/='p') stop 1 + if(any(a/=u)) stop 2 + ! + a = u + c = attr_p_ar(a, .true._c_bool) + if(c/='p') stop 3 + if(any(a/=u)) stop 4 + ! + a = u + c = attr_o_as(a, .true._c_bool) + if(c/='o') stop 5 + if(any(a/=u)) stop 6 + ! + a = u + c = attr_o_ar(a, .true._c_bool) + if(c/='o') stop 7 + if(any(a/=u)) stop 8 + ! + allocate(b, source=u) + c = attr_p_as(b, .true._c_bool) + if(c/='p') stop 9 + if(.not.allocated(b)) stop 10 + if(any(b/=u)) stop 11 + ! + deallocate(b) + allocate(b, source=u) + c = attr_p_ar(b, .true._c_bool) + if(c/='p') stop 12 + if(.not.allocated(b)) stop 13 + if(any(b/=u)) stop 14 + ! + deallocate(b) + allocate(b, source=u) + c = attr_a_as(b, .true._c_bool) + if(c/='a') stop 15 + if(.not.allocated(b)) stop 16 + if(any(b/=u)) stop 17 + ! + deallocate(b) + allocate(b, source=u) + c = attr_a_ar(b, .true._c_bool) + if(c/='a') stop 18 + if(.not.allocated(b)) stop 19 + if(any(b/=u)) stop 20 + ! + deallocate(b) + allocate(b, source=u) + c = attr_o_as(b, .true._c_bool) + if(c/='o') stop 21 + if(.not.allocated(b)) stop 22 + if(any(b/=u)) stop 23 + ! + deallocate(b) + allocate(b, source=u) + c = attr_o_ar(b, .true._c_bool) + if(c/='o') stop 24 + if(.not.allocated(b)) stop 25 + if(any(b/=u)) stop 26 + ! + deallocate(b) + c = attr_a_as(b, .false._c_bool) + if(c/='a') stop 27 + if(allocated(b)) stop 28 + ! + c = attr_a_ar(b, .false._c_bool) + if(c/='a') stop 29 + if(allocated(b)) stop 30 + ! + nullify(p) + p => a + c = attr_p_as(p, .true._c_bool) + if(c/='p') stop 31 + if(.not.associated(p)) stop 32 + if(.not.associated(p, a)) stop 33 + if(any(p/=u)) stop 34 + ! + nullify(p) + p => a + c = attr_p_ar(p, .true._c_bool) + if(c/='p') stop 35 + if(.not.associated(p)) stop 36 + if(.not.associated(p, a)) stop 37 + if(any(p/=u)) stop 38 + ! + nullify(p) + p => a + c = attr_o_as(p, .true._c_bool) + if(c/='o') stop 39 + if(.not.associated(p)) stop 40 + if(.not.associated(p, a)) stop 41 + if(any(p/=u)) stop 42 + ! + nullify(p) + p => a + c = attr_o_ar(p, .true._c_bool) + if(c/='o') stop 43 + if(.not.associated(p)) stop 44 + if(.not.associated(p, a)) stop 45 + if(any(p/=u)) stop 46 + ! + nullify(p) + c = attr_p_as(p, .false._c_bool) + if(c/='p') stop 47 + if(associated(p)) stop 48 + if(associated(p, a)) stop 49 + ! + nullify(p) + c = attr_p_ar(p, .false._c_bool) + if(c/='p') stop 50 + if(associated(p)) stop 51 + if(associated(p, a)) stop 52 + stop + +end program attr_p diff --git a/gcc/testsuite/gfortran.dg/PR94331.c b/gcc/testsuite/gfortran.dg/PR94331.c new file mode 100644 index 0000000..4e13051 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94331.c @@ -0,0 +1,73 @@ +/* Test the fix for PR94331. */ + +#include <assert.h> +#include <stdbool.h> +#include <stdlib.h> + +#include "../../../libgfortran/ISO_Fortran_binding.h" + +bool c_vrfy (const CFI_cdesc_t *restrict); + +bool check_bounds(const CFI_cdesc_t*restrict, const int, const int); + +bool +c_vrfy (const CFI_cdesc_t *restrict auxp) +{ + CFI_index_t i, lb, ub, ex; + int *ip = NULL; + + assert (auxp); + assert (auxp->base_addr); + lb = auxp->dim[0].lower_bound; + ex = auxp->dim[0].extent; + ub = ex + lb - 1; + ip = (int*)auxp->base_addr; + for (i=0; i<ex; i++) + if (*ip++ != i+1) + return false; + for (i=lb; i<ub+1; i++) + { + ip = (int*)CFI_address(auxp, &i); + if (*ip != i-lb+1) + return false; + } + return true; +} + +bool +check_bounds (const CFI_cdesc_t *restrict auxp, const int lb, const int ub) +{ + CFI_index_t ex = ub-lb+1; + size_t el; + bool is_ok = false; + + assert (auxp); + el = auxp->elem_len; + assert (auxp->rank==1); + assert (auxp->type==CFI_type_int); + assert (auxp->dim[0].sm>0); + assert ((size_t)auxp->dim[0].sm==el); + if (auxp->dim[0].extent==ex + && auxp->dim[0].lower_bound==lb) + { + switch(auxp->attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + if (!c_vrfy (auxp)) + break; + is_ok = true; + break; + case CFI_attribute_other: + if (!c_vrfy (auxp)) + break; + is_ok = (lb==0); + break; + default: + assert (false); + break; + } + } + return is_ok; +} + diff --git a/gcc/testsuite/gfortran.dg/PR94331.f90 b/gcc/testsuite/gfortran.dg/PR94331.f90 new file mode 100644 index 0000000..6185031 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94331.f90 @@ -0,0 +1,252 @@ +! { dg-do run } +! { dg-additional-sources PR94331.c } +! +! Test the fix for PR94331 +! + +program main_p + + use, intrinsic :: iso_c_binding, only: & + c_int + + implicit none + + integer :: i + integer, parameter :: ex = 11 + integer, parameter :: lb = 11 + integer, parameter :: ub = ex+lb-1 + integer, parameter :: u(*) = [(i, i=1,ex)] + + interface + function checkb_p_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), pointer, intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_p_as + function checkb_a_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_a_as + function checkb_o_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_o_as + function checkb_p_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), pointer, intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_p_ar + function checkb_a_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_a_ar + function checkb_o_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_o_ar + end interface + + integer(kind=c_int), target :: a(lb:ub) + integer(kind=c_int), allocatable, target :: b(:) + integer(kind=c_int), pointer :: p(:) + + a = u + if(lbound(a,1)/=lb) stop 1 + if(ubound(a,1)/=ub) stop 2 + if(any(shape(a)/=[ex])) stop 3 + if(.not.checkb_p_as(a, lb, ub)) stop 4 + if(lbound(a,1)/=lb) stop 5 + if(ubound(a,1)/=ub) stop 6 + if(any(shape(a)/=[ex])) stop 7 + if(any(a/=u)) stop 8 + ! + a = u + if(lbound(a,1)/=lb) stop 9 + if(ubound(a,1)/=ub) stop 10 + if(any(shape(a)/=[ex])) stop 11 + if(.not.checkb_p_ar(a, lb, ub)) stop 12 + if(lbound(a,1)/=lb) stop 13 + if(ubound(a,1)/=ub) stop 14 + if(any(shape(a)/=[ex])) stop 15 + if(any(a/=u)) stop 16 + ! + a = u + if(lbound(a,1)/=lb) stop 17 + if(ubound(a,1)/=ub) stop 18 + if(any(shape(a)/=[ex])) stop 19 + if(.not.checkb_o_as(a, 0, ex-1))stop 20 + if(lbound(a,1)/=lb) stop 21 + if(ubound(a,1)/=ub) stop 22 + if(any(shape(a)/=[ex])) stop 23 + if(any(a/=u)) stop 24 + ! + a = u + if(lbound(a,1)/=lb) stop 25 + if(ubound(a,1)/=ub) stop 26 + if(any(shape(a)/=[ex])) stop 27 + if(.not.checkb_o_ar(a, 0, ex-1))stop 28 + if(lbound(a,1)/=lb) stop 29 + if(ubound(a,1)/=ub) stop 30 + if(any(shape(a)/=[ex])) stop 31 + if(any(a/=u)) stop 32 + ! + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 33 + if(ubound(b,1)/=ub) stop 34 + if(any(shape(b)/=[ex])) stop 35 + if(.not.checkb_p_as(b, lb, ub)) stop 36 + if(.not.allocated(b)) stop 37 + if(lbound(b,1)/=lb) stop 38 + if(ubound(b,1)/=ub) stop 39 + if(any(shape(b)/=[ex])) stop 40 + if(any(b/=u)) stop 41 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 42 + if(ubound(b,1)/=ub) stop 43 + if(any(shape(b)/=[ex])) stop 44 + if(.not.checkb_p_ar(b, lb, ub)) stop 45 + if(.not.allocated(b)) stop 46 + if(lbound(b,1)/=lb) stop 47 + if(ubound(b,1)/=ub) stop 48 + if(any(shape(b)/=[ex])) stop 49 + if(any(b/=u)) stop 50 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 51 + if(ubound(b,1)/=ub) stop 52 + if(any(shape(b)/=[ex])) stop 53 + if(.not.checkb_a_as(b, lb, ub)) stop 54 + if(.not.allocated(b)) stop 55 + if(lbound(b,1)/=lb) stop 56 + if(ubound(b,1)/=ub) stop 57 + if(any(shape(b)/=[ex])) stop 58 + if(any(b/=u)) stop 59 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 60 + if(ubound(b,1)/=ub) stop 61 + if(any(shape(b)/=[ex])) stop 62 + if(.not.checkb_a_ar(b, lb, ub)) stop 63 + if(.not.allocated(b)) stop 64 + if(lbound(b,1)/=lb) stop 65 + if(ubound(b,1)/=ub) stop 66 + if(any(shape(b)/=[ex])) stop 67 + if(any(b/=u)) stop 68 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 69 + if(ubound(b,1)/=ub) stop 70 + if(any(shape(b)/=[ex])) stop 71 + if(.not.checkb_o_as(b, 0, ex-1))stop 72 + if(.not.allocated(b)) stop 73 + if(lbound(b,1)/=lb) stop 74 + if(ubound(b,1)/=ub) stop 75 + if(any(shape(b)/=[ex])) stop 76 + if(any(b/=u)) stop 77 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 78 + if(ubound(b,1)/=ub) stop 79 + if(any(shape(b)/=[ex])) stop 80 + if(.not.checkb_o_ar(b, 0, ex-1))stop 81 + if(.not.allocated(b)) stop 82 + if(lbound(b,1)/=lb) stop 83 + if(ubound(b,1)/=ub) stop 84 + if(any(shape(b)/=[ex])) stop 85 + if(any(b/=u)) stop 86 + deallocate(b) + ! + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 87 + if(ubound(p,1)/=ub) stop 88 + if(any(shape(p)/=[ex])) stop 89 + if(.not.checkb_p_as(p, lb, ub)) stop 90 + if(.not.associated(p)) stop 91 + if(.not.associated(p, a)) stop 92 + if(lbound(p,1)/=lb) stop 93 + if(ubound(p,1)/=ub) stop 94 + if(any(shape(p)/=[ex])) stop 95 + if(any(p/=u)) stop 96 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 97 + if(ubound(p,1)/=ub) stop 98 + if(any(shape(p)/=[ex])) stop 99 + if(.not.checkb_p_ar(p, lb, ub)) stop 100 + if(.not.associated(p)) stop 101 + if(.not.associated(p, a)) stop 102 + if(lbound(p,1)/=lb) stop 103 + if(ubound(p,1)/=ub) stop 104 + if(any(shape(p)/=[ex])) stop 105 + if(any(p/=u)) stop 106 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 107 + if(ubound(p,1)/=ub) stop 108 + if(any(shape(p)/=[ex])) stop 109 + if(.not.checkb_o_as(p, 0, ex-1))stop 110 + if(.not.associated(p)) stop 111 + if(.not.associated(p, a)) stop 112 + if(lbound(p,1)/=lb) stop 113 + if(ubound(p,1)/=ub) stop 114 + if(any(shape(p)/=[ex])) stop 115 + if(any(p/=u)) stop 116 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 117 + if(ubound(p,1)/=ub) stop 118 + if(any(shape(p)/=[ex])) stop 119 + if(.not.checkb_o_ar(p, 0, ex-1))stop 120 + if(.not.associated(p)) stop 121 + if(.not.associated(p, a)) stop 122 + if(lbound(p,1)/=lb) stop 123 + if(ubound(p,1)/=ub) stop 124 + if(any(shape(p)/=[ex])) stop 125 + if(any(p/=u)) stop 126 + nullify(p) + stop + +end program main_p diff --git a/gcc/testsuite/gfortran.dg/PR97046.f90 b/gcc/testsuite/gfortran.dg/PR97046.f90 new file mode 100644 index 0000000..7d133a5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR97046.f90 @@ -0,0 +1,58 @@ +! { dg-do run } +! +! Test the fix for PR94331 +! +! Contributed by Igor Gayday <igor.gayday@mu.edu> +! + +MODULE FOO + + implicit none + + INTEGER, parameter :: n = 11 + +contains + + SUBROUTINE dummyc(x0) BIND(C) + type(*), dimension(..) :: x0 + if(LBOUND(x0,1)/=1) stop 5 + if(UBOUND(x0,1)/=n) stop 6 + if(rank(x0)/=1) stop 7 + END SUBROUTINE dummyc + + SUBROUTINE dummy(x0) + type(*), dimension(..) :: x0 + call dummyc(x0) + END SUBROUTINE dummy + +END MODULE + +PROGRAM main + USE FOO + IMPLICIT NONE + integer :: before(2), after(2) + + DOUBLE PRECISION, ALLOCATABLE :: buf(:) + DOUBLE PRECISION :: buf2(n) + + ALLOCATE(buf(n)) + before(1) = LBOUND(buf,1) + before(2) = UBOUND(buf,1) + CALL dummy (buf) + after(1) = LBOUND(buf,1) + after(2) = UBOUND(buf,1) + deallocate(buf) + + if (before(1) .NE. after(1)) stop 1 + if (before(2) .NE. after(2)) stop 2 + + before(1) = LBOUND(buf2,1) + before(2) = UBOUND(buf2,1) + CALL dummy (buf2) + after(1) = LBOUND(buf2,1) + after(2) = UBOUND(buf2,1) + + if (before(1) .NE. after(1)) stop 3 + if (before(2) .NE. after(2)) stop 4 + +END PROGRAM diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 index 00628c1..ede6eff 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 @@ -22,4 +22,4 @@ end ! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } } ! { dg-final { scan-assembler-times "bl \.myBindC" 1 { target { powerpc-ibm-aix* } } } } ! { dg-final { scan-assembler-times "add_u32\t\[sv\]\[0-9\]*, \[sv\]\[0-9\]*, myBindC@rel32@lo" 1 { target { amdgcn*-*-* } } } } -! { dg-final { scan-tree-dump-times "cfi_desc_to_gfc_desc \\\(&parm\\." 1 "original" } } +! { dg-final { scan-tree-dump-times "gfc_desc_to_cfi_desc \\\(&cfi\\." 1 "original" } } diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 20833ad..db9b32b 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -43,6 +43,20 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) if (!s) return; + /* Verify descriptor. */ + switch(s->attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + /* FALL THROUGH */ + default: + internal_error (NULL, "INVALID CFI DESCRIPTOR"); + break; + } 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); @@ -74,14 +88,19 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) } d->offset = 0; - for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) - { - GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)s->dim[n].lower_bound; - GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent - + s->dim[n].lower_bound - 1); - 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); - } + if (GFC_DESCRIPTOR_DATA (d)) + for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) + { + CFI_index_t lb = 1; + + if (s->attribute != CFI_attribute_other) + lb = s->dim[n].lower_bound; + + GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)lb; + GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent + lb - 1); + 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); + } } extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *); @@ -102,6 +121,20 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) else d = *d_ptr; + /* Verify descriptor. */ + switch (s->dtype.attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + /* FALL THROUGH */ + default: + internal_error (NULL, "INVALID GFC DESCRIPTOR"); + break; + } d->base_addr = GFC_DESCRIPTOR_DATA (s); d->elem_len = GFC_DESCRIPTOR_SIZE (s); d->version = s->dtype.version; ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-14 23:09 [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling José Rui Faustino de Sousa @ 2021-06-21 13:46 ` Tobias Burnus 2021-06-21 15:51 ` José Rui Faustino de Sousa 0 siblings, 1 reply; 9+ messages in thread From: Tobias Burnus @ 2021-06-21 13:46 UTC (permalink / raw) To: José Rui Faustino de Sousa, fortran, gcc-patches Hi José, (in principle, I'd like to have the libgfortran function moved to the compiler proper to avoid some issues, but that's admittedly a task independent of your work.) On 15.06.21 01:09, José Rui Faustino de Sousa via Fortran wrote: > Update to a proposed patch to: > Bug 93308 - bind(c) subroutine changes lower bound of array argument > in caller > Bug 93963 - Select rank mishandling allocatable and pointer arguments > with bind(c) > Bug 94327 - Bind(c) argument attributes are incorrectly set > Bug 94331 - Bind(C) corrupts array descriptors > Bug 97046 - Bad interaction between lbound/ubound, allocatable arrays > and bind(C) subroutine with dimension(..) parameter > ... > Patch tested only on x86_64-pc-linux-gnu. > Fix attribute handling, which reflect a prior intermediate version of > the Fortran standard. LGTM – except for one minor nit. In trans-expr.c's gfc_conv_gfc_desc_to_cfi_desc: /* Transfer values back to gfc descriptor. */ + if (cfi_attribute != 2 + && !fsym->attr.value + && fsym->attr.intent != INTENT_IN) Can you add after the '2' the string ' /* CFI_attribute_other. */' to make the number less magic. Thanks, Tobias > > CFI descriptors, in most cases, should not be copied out has they can > corrupt the Fortran descriptor. Bounds will vary and the original > Fortran bounds are definitively lost on conversion. > > Thank you very much. > > Best regards, > José Rui > > Fortran: Fix attributtes and bounds in ISO_Fortran_binding. > > gcc/fortran/ChangeLog: > > PR fortran/93308 > PR fortran/93963 > PR fortran/94327 > PR fortran/94331 > PR fortran/97046 > * trans-decl.c (convert_CFI_desc): Only copy out the descriptor > if necessary. > * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute > handling which reflect a previous intermediate version of the > standard. Only copy out the descriptor if necessary. > > libgfortran/ChangeLog: > > PR fortran/93308 > PR fortran/93963 > PR fortran/94327 > PR fortran/94331 > PR fortran/97046 > * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code > to verify the descriptor. Correct bounds calculation. > (gfc_desc_to_cfi_desc): Add code to verify the descriptor. > > gcc/testsuite/ChangeLog: > > PR fortran/93308 > PR fortran/93963 > PR fortran/94327 > PR fortran/94331 > PR fortran/97046 > * gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute, > this test is still erroneous but now it compiles. > * gfortran.dg/bind_c_array_params_2.f90: Update regex to match > code changes. > * gfortran.dg/PR93308.f90: New test. > * gfortran.dg/PR93963.f90: New test. > * gfortran.dg/PR94327.c: New test. > * gfortran.dg/PR94327.f90: New test. > * gfortran.dg/PR94331.c: New test. > * gfortran.dg/PR94331.f90: New test. > * gfortran.dg/PR97046.f90: New test. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-21 13:46 ` Tobias Burnus @ 2021-06-21 15:51 ` José Rui Faustino de Sousa 2021-06-21 16:46 ` Tobias Burnus 0 siblings, 1 reply; 9+ messages in thread From: José Rui Faustino de Sousa @ 2021-06-21 15:51 UTC (permalink / raw) To: Tobias Burnus, fortran, gcc-patches On 21/06/21 13:46, Tobias Burnus wrote: > Hi José, > > (in principle, I'd like to have the libgfortran function moved to the > compiler proper to avoid some issues, but that's admittedly a task > independent of your work.) > cfi_desc_to_gfc_desc and gfc_desc_to_cfi_desc from ISO_c_binding.c, right? Since fixing: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100917 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100910 would very likely require passing an additional "kind" parameter (and future descriptor unification) that would be a good idea. I had a patch to do this, passing the kind value, but AFAIR there were issues with kind values for C_PTR and C_FUNPTR (and I didn't want to mess with the ABI also in one go)... But I might have fixed that somewhere else afterwards... So, I could look further into that. Were would you like them placed? > LGTM – except for one minor nit. In trans-expr.c's > gfc_conv_gfc_desc_to_cfi_desc: > > /* Transfer values back to gfc descriptor. */ > + if (cfi_attribute != 2 > + && !fsym->attr.value > + && fsym->attr.intent != INTENT_IN) > > Can you add after the '2' the string ' /* CFI_attribute_other. */' > to make the number less magic. > Yes... I had the same idea... :-) But all those constants are defined in "ISO_Fortran_binding.h"... And moving all those definitions would be a major change... So I left it as it was... What do you suggest I do? Best regards, José Rui ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-21 15:51 ` José Rui Faustino de Sousa @ 2021-06-21 16:46 ` Tobias Burnus 2021-06-21 17:52 ` José Rui Faustino de Sousa 0 siblings, 1 reply; 9+ messages in thread From: Tobias Burnus @ 2021-06-21 16:46 UTC (permalink / raw) To: José Rui Faustino de Sousa, Tobias Burnus, fortran, gcc-patches Hi José, On 21.06.21 17:51, José Rui Faustino de Sousa via Fortran wrote: > On 21/06/21 13:46, Tobias Burnus wrote: >> >> (in principle, I'd like to have the libgfortran function moved to the >> compiler proper to avoid some issues, but that's admittedly a task >> independent of your work.) > cfi_desc_to_gfc_desc and gfc_desc_to_cfi_desc from ISO_c_binding.c, > right? Yes. > > So, I could look further into that. Were would you like them placed? Well, as said: directly into the compiler where currently the call to libgomp is. >> LGTM – except for one minor nit. Found a second tiny nit: + if (GFC_DESCRIPTOR_DATA (d)) + for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) + { + CFI_index_t lb = 1; + + if (s->attribute != CFI_attribute_other) There is tailing whitespace in the otherwise empty line. >> In trans-expr.c's gfc_conv_gfc_desc_to_cfi_desc: >> >> /* Transfer values back to gfc descriptor. */ >> + if (cfi_attribute != 2 >> + && !fsym->attr.value >> + && fsym->attr.intent != INTENT_IN) >> >> Can you add after the '2' the string ' /* CFI_attribute_other. */' >> to make the number less magic. > > Yes... I had the same idea... :-) But all those constants are defined > in "ISO_Fortran_binding.h"... And moving all those definitions would > be a major change... So I left it as it was... Well, I am currently only asking to add a comment after the "2;". This fixing those two nits (removing tailing whitespace + adding a comment) and is be trivial. * * * However, in the long run, I think we should put it into either a separate file, which is included into ISO_Fortran_binding.h and the proper compiler (and installed alongside ISO_Fortran_binding.h) - or just in libgfortran.h and adding some check/(static)assert that it matches to the value in ISO_Fortran_binding.h. Or, possibly, we could also include ISO_Fortran_binding.h when building the compiler itself, possibly adding some '#ifdef' code to disable parts we do not want when we do #include. it. (We already have '#include "libgfortran.h"' in gcc/fortran/gfortran.h.) Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-21 16:46 ` Tobias Burnus @ 2021-06-21 17:52 ` José Rui Faustino de Sousa 2021-06-21 20:29 ` Tobias Burnus 0 siblings, 1 reply; 9+ messages in thread From: José Rui Faustino de Sousa @ 2021-06-21 17:52 UTC (permalink / raw) To: Tobias Burnus, fortran, gcc-patches Hi Tobias, On 21/06/21 16:46, Tobias Burnus wrote: > Well, as said: directly into the compiler where currently the call to > libgomp is. > I don't think I understand were you mean. You don't mean the includes in "f95-lang.c" do you? Best regards, José Rui ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-21 17:52 ` José Rui Faustino de Sousa @ 2021-06-21 20:29 ` Tobias Burnus 2021-06-22 7:11 ` Tobias Burnus 0 siblings, 1 reply; 9+ messages in thread From: Tobias Burnus @ 2021-06-21 20:29 UTC (permalink / raw) To: José Rui Faustino de Sousa, fortran, gcc-patches Hi José, On 21.06.21 19:52, José Rui Faustino de Sousa wrote: > On 21/06/21 16:46, Tobias Burnus wrote: >> Well, as said: directly into the compiler where currently the call to >> libgomp is. (should be libgfortran) I meant converting the operation done by the libgfortran/runtime/ISO_Fortran_binding.c functions * cfi_desc_to_gfc_desc and *gfc_desc_to_cfi_desc into tree code, generated in place by the current callers * gfor_fndecl_gfc_to_cfi (in trans-decl.c) * gfc_conv_gfc_desc_to_cfi_desc (in trans-expr.c) And then effectively retiring those functions (except for old code which still calls them). * * * However, that's independent from the patch you had submitted and which is fine except for the two tiny nits. Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-21 20:29 ` Tobias Burnus @ 2021-06-22 7:11 ` Tobias Burnus 2021-07-26 12:43 ` Committed: " Tobias Burnus 0 siblings, 1 reply; 9+ messages in thread From: Tobias Burnus @ 2021-06-22 7:11 UTC (permalink / raw) To: José Rui Faustino de Sousa, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 600 bytes --] On 21.06.21 22:29, Tobias Burnus wrote: > However, that's independent from the patch you had submitted > and which is fine except for the two tiny nits. As I just did run into a test, which does trigger the error, I think it would be useful to have something like the following on top of your patch – what do you think? (Two of the changes are the nit changes I mentioned in the LGTM approval.) Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf [-- Attachment #2: patch.diff --] [-- Type: text/x-patch, Size: 1403 bytes --] diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 52e243bd463..73ce33185f1 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5616,3 +5616,3 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) /* Transfer values back to gfc descriptor. */ - if (cfi_attribute != 2 + if (cfi_attribute != 2 /* CFI_attribute_other. */ && !fsym->attr.value diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 801b7556765..1b845df0e77 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -56,3 +56,4 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) default: - internal_error (NULL, "INVALID CFI DESCRIPTOR"); + runtime_error ("Unallocated, unassociated actual argument to " + "BIND(C) with non-allocatable, non-pointer dummy"); break; @@ -94,3 +95,3 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) CFI_index_t lb = 1; - + if (s->attribute != CFI_attribute_other) @@ -134,3 +135,4 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) default: - internal_error (NULL, "INVALID GFC DESCRIPTOR"); + runtime_error ("Unallocated, unassociated actual argument to " + "BIND(C) with non-allocatable, non-pointer dummy"); break; ^ permalink raw reply [flat|nested] 9+ messages in thread
* Committed: Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-22 7:11 ` Tobias Burnus @ 2021-07-26 12:43 ` Tobias Burnus 0 siblings, 0 replies; 9+ messages in thread From: Tobias Burnus @ 2021-07-26 12:43 UTC (permalink / raw) To: José Rui Faustino de Sousa, fortran, gcc-patches, Sandra Loosemore [-- Attachment #1: Type: text/plain, Size: 1998 bytes --] I have now committed José's patch with the two nits fixed (cf. my on-top patch to which I just replied) r12-2511-g0cbf03689e3e7d9d6002b8e5d159ef3716d0404c Note: I have slightly reworded the error message compared to both the original patch and to my on-top suggestion. Reason: When calling a BIND(C) function from Fortran, it might happen that a actual or effective argument is an allocatable or pointer that is no allocatated/associated (→ base_addr == NULL) but whose dtype.attribute is 'other' as the dummy argument is nonallocatable/nonpointer. Likewise, when passing a base_addr == NULL from C to a Fortran-written BIND(C) procedure where attribute == CFI_attribute_other. Those errors are much more likely than having some other bug. Thus, those get now an error on their own instead of a generic error, even though the reason can be the same as for: On the other hand, if the attribute != 0, 1, 2 it is invalid, which either is a bug in the compiler, random/uninitialized memory or a bug in the C code setting up the descriptor. Thus, the error message is now different. Comments to the new wording + comments/remarks to this commit (or any new or existing code) are welcome :-) Thanks, Tobias PS: I wrote: On 22.06.21 09:11, Tobias Burnus wrote: > On 21.06.21 22:29, Tobias Burnus wrote: >> However, that's independent from the patch you had submitted >> and which is fine except for the two tiny nits. > As I just did run into a test, which does trigger the error, I think > it would be useful to have something like the following on top > of your patch – what do you think? > > (Two of the changes are the nit changes I mentioned in the > LGTM approval.) ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 [-- Attachment #2: committed.diff --] [-- Type: text/x-patch, Size: 35274 bytes --] commit 0cbf03689e3e7d9d6002b8e5d159ef3716d0404c Author: Tobias Burnus <tobias@codesourcery.com> Date: Mon Jul 26 14:20:46 2021 +0200 PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling Fortran: Fix attributes and bounds in ISO_Fortran_binding. 2021-07-26 José Rui Faustino de Sousa <jrfsousa@gmail.com> Tobias Burnus <tobias@codesourcery.com> PR fortran/93308 PR fortran/93963 PR fortran/94327 PR fortran/94331 PR fortran/97046 gcc/fortran/ChangeLog: * trans-decl.c (convert_CFI_desc): Only copy out the descriptor if necessary. * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute handling which reflect a previous intermediate version of the standard. Only copy out the descriptor if necessary. libgfortran/ChangeLog: * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code to verify the descriptor. Correct bounds calculation. (gfc_desc_to_cfi_desc): Add code to verify the descriptor. gcc/testsuite/ChangeLog: * gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute, this test is still erroneous but now it compiles. * gfortran.dg/bind_c_array_params_2.f90: Update regex to match code changes. * gfortran.dg/PR93308.f90: New test. * gfortran.dg/PR93963.f90: New test. * gfortran.dg/PR94327.c: New test. * gfortran.dg/PR94327.f90: New test. * gfortran.dg/PR94331.c: New test. * gfortran.dg/PR94331.f90: New test. * gfortran.dg/PR97046.f90: New test. --- gcc/fortran/trans-decl.c | 32 +-- gcc/fortran/trans-expr.c | 24 +- .../gfortran.dg/ISO_Fortran_binding_1.f90 | 2 +- gcc/testsuite/gfortran.dg/PR93308.f90 | 52 +++++ gcc/testsuite/gfortran.dg/PR93963.f90 | 150 ++++++++++++ gcc/testsuite/gfortran.dg/PR94327.c | 70 ++++++ gcc/testsuite/gfortran.dg/PR94327.f90 | 195 ++++++++++++++++ gcc/testsuite/gfortran.dg/PR94331.c | 73 ++++++ gcc/testsuite/gfortran.dg/PR94331.f90 | 252 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/PR97046.f90 | 58 +++++ .../gfortran.dg/bind_c_array_params_2.f90 | 2 +- libgfortran/runtime/ISO_Fortran_binding.c | 56 ++++- 12 files changed, 933 insertions(+), 33 deletions(-) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index bf8783a35f8..784f7b61ce1 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4539,22 +4539,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym) gfc_add_expr_to_block (&outer_block, incoming); incoming = gfc_finish_block (&outer_block); - /* Convert the gfc descriptor back to the CFI type before going out of scope, if the CFI type was present at entry. */ - gfc_init_block (&outer_block); - gfc_init_block (&tmpblock); - - tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); - outgoing = build_call_expr_loc (input_location, - gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); - gfc_add_expr_to_block (&tmpblock, outgoing); + outgoing = NULL_TREE; + if ((sym->attr.pointer || sym->attr.allocatable) + && !sym->attr.value + && sym->attr.intent != INTENT_IN) + { + gfc_init_block (&outer_block); + gfc_init_block (&tmpblock); - outgoing = build3_v (COND_EXPR, present, - gfc_finish_block (&tmpblock), - build_empty_stmt (input_location)); - gfc_add_expr_to_block (&outer_block, outgoing); - outgoing = gfc_finish_block (&outer_block); + tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); + outgoing = build_call_expr_loc (input_location, + gfor_fndecl_gfc_to_cfi, 2, + tmp, gfc_desc_ptr); + gfc_add_expr_to_block (&tmpblock, outgoing); + + outgoing = build3_v (COND_EXPR, present, + gfc_finish_block (&tmpblock), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&outer_block, outgoing); + outgoing = gfc_finish_block (&outer_block); + } /* Add the lot to the procedure init and finally blocks. */ gfc_add_init_cleanup (block, incoming, outgoing); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b18a9ec9799..c4291cce079 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5502,13 +5502,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) attribute = 1; } - /* If the formal argument is assumed shape and neither a pointer nor - allocatable, it is unconditionally CFI_attribute_other. */ - if (fsym->as->type == AS_ASSUMED_SHAPE - && !fsym->attr.pointer && !fsym->attr.allocatable) - cfi_attribute = 2; + if (fsym->attr.pointer) + cfi_attribute = 0; + else if (fsym->attr.allocatable) + cfi_attribute = 1; else - cfi_attribute = attribute; + cfi_attribute = 2; if (e->rank != 0) { @@ -5616,10 +5615,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) 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_prepend_expr_to_block (&parmse->post, tmp); + if (cfi_attribute != 2 /* CFI_attribute_other. */ + && !fsym->attr.value + && fsym->attr.intent != INTENT_IN) + { + tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp); + gfc_prepend_expr_to_block (&parmse->post, tmp); + } /* Deal with an optional dummy being passed to an optional formal arg by finishing the pre and post blocks and making their execution diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 index 102bc60310c..0cf3b2cb88c 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 @@ -39,7 +39,7 @@ USE, INTRINSIC :: ISO_C_BINDING import INTEGER(C_INT) :: err - type (T), DIMENSION(..), intent(out) :: a + type (T), pointer, DIMENSION(..), intent(out) :: a END FUNCTION c_establish FUNCTION c_contiguous(a) BIND(C, NAME="contiguous_c") RESULT(err) diff --git a/gcc/testsuite/gfortran.dg/PR93308.f90 b/gcc/testsuite/gfortran.dg/PR93308.f90 new file mode 100644 index 00000000000..ee116f961de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR93308.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! +! Test the fix for PR94331 +! +! Contributed by Robin Hogan <r.j.hogan@reading.ac.uk> +! + +program test + + use, intrinsic :: iso_c_binding, only: & + c_int, c_float + + implicit none + + integer :: i + integer, parameter :: n = 11 + real(kind=c_float), parameter :: u(*) = [(real(i, kind=c_float), i=1,n)] + + real(kind=c_float), allocatable :: A(:) + real(kind=c_float) :: E(n) + integer(kind=c_int) :: l1, l2, l3 + + allocate(A, source=u) + l1 = lbound(A, 1) + call routine_bindc(A, l2) ! in gcc-9.2.1 this changes lbound of A... + l3 = lbound(A, 1) + if (l1 /= 1) stop 1 + if (l1 /= l2) stop 2 + if (l1 /= l3) stop 3 + if (any(abs(A(1:n)-u)>0.0_c_float)) stop 4 + deallocate(A) + ! + E = u + l1 = lbound(E, 1) + call routine_bindc(E, l2) ! ...but does not change lbound of E + l3 = lbound(E, 1) + if (l1 /= 1) stop 5 + if (l1 /= l2) stop 6 + if (l1 /= l3) stop 7 + if (any(abs(E(1:n)-u)>0.0_c_float)) stop 8 + +contains + + subroutine routine_bindc(v, l) bind(c) + real(kind=c_float), intent(inout) :: v(:) + integer(kind=c_int), intent(out) :: l + + l = lbound(v, 1) + if (any(abs(v(1:n)-u)>0.0_c_float)) stop 9 + end subroutine routine_bindc + +end program test diff --git a/gcc/testsuite/gfortran.dg/PR93963.f90 b/gcc/testsuite/gfortran.dg/PR93963.f90 new file mode 100644 index 00000000000..4e1b06fd525 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR93963.f90 @@ -0,0 +1,150 @@ +! { dg-do run } +! +! Test the fix for PR93963 +! + +function rank_p(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + integer(kind=c_int), pointer, intent(in) :: this(..) + integer(kind=c_int) :: rnk + + select rank(this) + rank(0) + rnk = 0 + rank(1) + rnk = 1 + rank(2) + rnk = 2 + rank(3) + rnk = 3 + rank(4) + rnk = 4 + rank(5) + rnk = 5 + rank(6) + rnk = 6 + rank(7) + rnk = 7 + rank(8) + rnk = 8 + rank(9) + rnk = 9 + rank(10) + rnk = 10 + rank(11) + rnk = 11 + rank(12) + rnk = 12 + rank(13) + rnk = 13 + rank(14) + rnk = 14 + rank(15) + rnk = 15 + rank default + rnk = -1000 + end select + return +end function rank_p + +function rank_a(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + integer(kind=c_int), allocatable, intent(in) :: this(..) + integer(kind=c_int) :: rnk + + select rank(this) + rank(0) + rnk = 0 + rank(1) + rnk = 1 + rank(2) + rnk = 2 + rank(3) + rnk = 3 + rank(4) + rnk = 4 + rank(5) + rnk = 5 + rank(6) + rnk = 6 + rank(7) + rnk = 7 + rank(8) + rnk = 8 + rank(9) + rnk = 9 + rank(10) + rnk = 10 + rank(11) + rnk = 11 + rank(12) + rnk = 12 + rank(13) + rnk = 13 + rank(14) + rnk = 14 + rank(15) + rnk = 15 + rank default + rnk = -1000 + end select + return +end function rank_a + +program selr_p + + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + interface + function rank_p(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + integer(kind=c_int), pointer, intent(in) :: this(..) + integer(kind=c_int) :: rnk + end function rank_p + end interface + + interface + function rank_a(this) result(rnk) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + integer(kind=c_int), allocatable, intent(in) :: this(..) + integer(kind=c_int) :: rnk + end function rank_a + end interface + + integer(kind=c_int), parameter :: siz = 7 + integer(kind=c_int), parameter :: rnk = 1 + + integer(kind=c_int), pointer :: intp(:) + integer(kind=c_int), allocatable :: inta(:) + integer(kind=c_int) :: irnk + + nullify(intp) + irnk = rank_p(intp) + if (irnk /= rnk) stop 1 + if (irnk /= rank(intp)) stop 2 + ! + irnk = rank_a(inta) + if (irnk /= rnk) stop 3 + if (irnk /= rank(inta)) stop 4 + ! + allocate(intp(siz)) + irnk = rank_p(intp) + if (irnk /= rnk) stop 5 + if (irnk /= rank(intp)) stop 6 + deallocate(intp) + nullify(intp) + ! + allocate(inta(siz)) + if (irnk /= rnk) stop 7 + if (irnk /= rank(inta)) stop 8 + deallocate(inta) + +end program selr_p diff --git a/gcc/testsuite/gfortran.dg/PR94327.c b/gcc/testsuite/gfortran.dg/PR94327.c new file mode 100644 index 00000000000..6791c373546 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94327.c @@ -0,0 +1,70 @@ +/* Test the fix for PR94327. */ + +#include <assert.h> +#include <stdbool.h> +#include <stdlib.h> + +#include "../../../libgfortran/ISO_Fortran_binding.h" + +bool c_vrfy (const CFI_cdesc_t *restrict); + +char get_attr (const CFI_cdesc_t*restrict, bool); + +bool +c_vrfy (const CFI_cdesc_t *restrict auxp) +{ + CFI_index_t i, lb, ub, ex; + int *ip = NULL; + + assert (auxp); + assert (auxp->base_addr); + lb = auxp->dim[0].lower_bound; + ex = auxp->dim[0].extent; + ub = ex + lb - 1; + ip = (int*)auxp->base_addr; + for (i=0; i<ex; i++) + if (*ip++ != i+1) + return false; + for (i=lb; i<ub+1; i++) + { + ip = (int*)CFI_address(auxp, &i); + if (*ip != i-lb+1) + return false; + } + return true; +} + +char +get_attr (const CFI_cdesc_t *restrict auxp, bool alloc) +{ + char attr; + + assert (auxp); + assert (auxp->elem_len == 4); + assert (auxp->rank == 1); + assert (auxp->type == CFI_type_int); + attr = '\0'; + switch (auxp->attribute) + { + case CFI_attribute_pointer: + if (alloc && !c_vrfy (auxp)) + break; + attr = 'p'; + break; + case CFI_attribute_allocatable: + if (alloc && !c_vrfy (auxp)) + break; + attr = 'a'; + break; + case CFI_attribute_other: + assert (alloc); + if (!c_vrfy (auxp)) + break; + attr = 'o'; + break; + default: + break; + } + return attr; +} + diff --git a/gcc/testsuite/gfortran.dg/PR94327.f90 b/gcc/testsuite/gfortran.dg/PR94327.f90 new file mode 100644 index 00000000000..3cb3ac3dda1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94327.f90 @@ -0,0 +1,195 @@ +! { dg-do run } +! { dg-additional-sources PR94327.c } +! +! Test the fix for PR94327 +! + +program attr_p + + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + + implicit none + + integer :: i + integer, parameter :: n = 11 + integer, parameter :: u(*) = [(i, i=1,n)] + + interface + function attr_p_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), pointer, intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_p_as + function attr_a_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_a_as + function attr_o_as(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), intent(in) :: a(:) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_o_as + function attr_p_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), pointer, intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_p_ar + function attr_a_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_a_ar + function attr_o_ar(a, s) result(c) & + bind(c, name="get_attr") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool, c_char + implicit none + integer(kind=c_int), intent(in) :: a(..) + logical(kind=c_bool), value, intent(in) :: s + character(kind=c_char) :: c + end function attr_o_ar + end interface + + integer(kind=c_int), target :: a(n) + integer(kind=c_int), allocatable, target :: b(:) + integer(kind=c_int), pointer :: p(:) + character(kind=c_char) :: c + + a = u + c = attr_p_as(a, .true._c_bool) + if(c/='p') stop 1 + if(any(a/=u)) stop 2 + ! + a = u + c = attr_p_ar(a, .true._c_bool) + if(c/='p') stop 3 + if(any(a/=u)) stop 4 + ! + a = u + c = attr_o_as(a, .true._c_bool) + if(c/='o') stop 5 + if(any(a/=u)) stop 6 + ! + a = u + c = attr_o_ar(a, .true._c_bool) + if(c/='o') stop 7 + if(any(a/=u)) stop 8 + ! + allocate(b, source=u) + c = attr_p_as(b, .true._c_bool) + if(c/='p') stop 9 + if(.not.allocated(b)) stop 10 + if(any(b/=u)) stop 11 + ! + deallocate(b) + allocate(b, source=u) + c = attr_p_ar(b, .true._c_bool) + if(c/='p') stop 12 + if(.not.allocated(b)) stop 13 + if(any(b/=u)) stop 14 + ! + deallocate(b) + allocate(b, source=u) + c = attr_a_as(b, .true._c_bool) + if(c/='a') stop 15 + if(.not.allocated(b)) stop 16 + if(any(b/=u)) stop 17 + ! + deallocate(b) + allocate(b, source=u) + c = attr_a_ar(b, .true._c_bool) + if(c/='a') stop 18 + if(.not.allocated(b)) stop 19 + if(any(b/=u)) stop 20 + ! + deallocate(b) + allocate(b, source=u) + c = attr_o_as(b, .true._c_bool) + if(c/='o') stop 21 + if(.not.allocated(b)) stop 22 + if(any(b/=u)) stop 23 + ! + deallocate(b) + allocate(b, source=u) + c = attr_o_ar(b, .true._c_bool) + if(c/='o') stop 24 + if(.not.allocated(b)) stop 25 + if(any(b/=u)) stop 26 + ! + deallocate(b) + c = attr_a_as(b, .false._c_bool) + if(c/='a') stop 27 + if(allocated(b)) stop 28 + ! + c = attr_a_ar(b, .false._c_bool) + if(c/='a') stop 29 + if(allocated(b)) stop 30 + ! + nullify(p) + p => a + c = attr_p_as(p, .true._c_bool) + if(c/='p') stop 31 + if(.not.associated(p)) stop 32 + if(.not.associated(p, a)) stop 33 + if(any(p/=u)) stop 34 + ! + nullify(p) + p => a + c = attr_p_ar(p, .true._c_bool) + if(c/='p') stop 35 + if(.not.associated(p)) stop 36 + if(.not.associated(p, a)) stop 37 + if(any(p/=u)) stop 38 + ! + nullify(p) + p => a + c = attr_o_as(p, .true._c_bool) + if(c/='o') stop 39 + if(.not.associated(p)) stop 40 + if(.not.associated(p, a)) stop 41 + if(any(p/=u)) stop 42 + ! + nullify(p) + p => a + c = attr_o_ar(p, .true._c_bool) + if(c/='o') stop 43 + if(.not.associated(p)) stop 44 + if(.not.associated(p, a)) stop 45 + if(any(p/=u)) stop 46 + ! + nullify(p) + c = attr_p_as(p, .false._c_bool) + if(c/='p') stop 47 + if(associated(p)) stop 48 + if(associated(p, a)) stop 49 + ! + nullify(p) + c = attr_p_ar(p, .false._c_bool) + if(c/='p') stop 50 + if(associated(p)) stop 51 + if(associated(p, a)) stop 52 + stop + +end program attr_p diff --git a/gcc/testsuite/gfortran.dg/PR94331.c b/gcc/testsuite/gfortran.dg/PR94331.c new file mode 100644 index 00000000000..4e130515455 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94331.c @@ -0,0 +1,73 @@ +/* Test the fix for PR94331. */ + +#include <assert.h> +#include <stdbool.h> +#include <stdlib.h> + +#include "../../../libgfortran/ISO_Fortran_binding.h" + +bool c_vrfy (const CFI_cdesc_t *restrict); + +bool check_bounds(const CFI_cdesc_t*restrict, const int, const int); + +bool +c_vrfy (const CFI_cdesc_t *restrict auxp) +{ + CFI_index_t i, lb, ub, ex; + int *ip = NULL; + + assert (auxp); + assert (auxp->base_addr); + lb = auxp->dim[0].lower_bound; + ex = auxp->dim[0].extent; + ub = ex + lb - 1; + ip = (int*)auxp->base_addr; + for (i=0; i<ex; i++) + if (*ip++ != i+1) + return false; + for (i=lb; i<ub+1; i++) + { + ip = (int*)CFI_address(auxp, &i); + if (*ip != i-lb+1) + return false; + } + return true; +} + +bool +check_bounds (const CFI_cdesc_t *restrict auxp, const int lb, const int ub) +{ + CFI_index_t ex = ub-lb+1; + size_t el; + bool is_ok = false; + + assert (auxp); + el = auxp->elem_len; + assert (auxp->rank==1); + assert (auxp->type==CFI_type_int); + assert (auxp->dim[0].sm>0); + assert ((size_t)auxp->dim[0].sm==el); + if (auxp->dim[0].extent==ex + && auxp->dim[0].lower_bound==lb) + { + switch(auxp->attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + if (!c_vrfy (auxp)) + break; + is_ok = true; + break; + case CFI_attribute_other: + if (!c_vrfy (auxp)) + break; + is_ok = (lb==0); + break; + default: + assert (false); + break; + } + } + return is_ok; +} + diff --git a/gcc/testsuite/gfortran.dg/PR94331.f90 b/gcc/testsuite/gfortran.dg/PR94331.f90 new file mode 100644 index 00000000000..6185031afc5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94331.f90 @@ -0,0 +1,252 @@ +! { dg-do run } +! { dg-additional-sources PR94331.c } +! +! Test the fix for PR94331 +! + +program main_p + + use, intrinsic :: iso_c_binding, only: & + c_int + + implicit none + + integer :: i + integer, parameter :: ex = 11 + integer, parameter :: lb = 11 + integer, parameter :: ub = ex+lb-1 + integer, parameter :: u(*) = [(i, i=1,ex)] + + interface + function checkb_p_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), pointer, intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_p_as + function checkb_a_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_a_as + function checkb_o_as(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), intent(in) :: a(:) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_o_as + function checkb_p_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), pointer, intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_p_ar + function checkb_a_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), allocatable, intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_a_ar + function checkb_o_ar(a, l, u) result(c) & + bind(c, name="check_bounds") + use, intrinsic :: iso_c_binding, only: & + c_int, c_bool + implicit none + integer(kind=c_int), intent(in) :: a(..) + integer(kind=c_int), value, intent(in) :: l + integer(kind=c_int), value, intent(in) :: u + logical(kind=c_bool) :: c + end function checkb_o_ar + end interface + + integer(kind=c_int), target :: a(lb:ub) + integer(kind=c_int), allocatable, target :: b(:) + integer(kind=c_int), pointer :: p(:) + + a = u + if(lbound(a,1)/=lb) stop 1 + if(ubound(a,1)/=ub) stop 2 + if(any(shape(a)/=[ex])) stop 3 + if(.not.checkb_p_as(a, lb, ub)) stop 4 + if(lbound(a,1)/=lb) stop 5 + if(ubound(a,1)/=ub) stop 6 + if(any(shape(a)/=[ex])) stop 7 + if(any(a/=u)) stop 8 + ! + a = u + if(lbound(a,1)/=lb) stop 9 + if(ubound(a,1)/=ub) stop 10 + if(any(shape(a)/=[ex])) stop 11 + if(.not.checkb_p_ar(a, lb, ub)) stop 12 + if(lbound(a,1)/=lb) stop 13 + if(ubound(a,1)/=ub) stop 14 + if(any(shape(a)/=[ex])) stop 15 + if(any(a/=u)) stop 16 + ! + a = u + if(lbound(a,1)/=lb) stop 17 + if(ubound(a,1)/=ub) stop 18 + if(any(shape(a)/=[ex])) stop 19 + if(.not.checkb_o_as(a, 0, ex-1))stop 20 + if(lbound(a,1)/=lb) stop 21 + if(ubound(a,1)/=ub) stop 22 + if(any(shape(a)/=[ex])) stop 23 + if(any(a/=u)) stop 24 + ! + a = u + if(lbound(a,1)/=lb) stop 25 + if(ubound(a,1)/=ub) stop 26 + if(any(shape(a)/=[ex])) stop 27 + if(.not.checkb_o_ar(a, 0, ex-1))stop 28 + if(lbound(a,1)/=lb) stop 29 + if(ubound(a,1)/=ub) stop 30 + if(any(shape(a)/=[ex])) stop 31 + if(any(a/=u)) stop 32 + ! + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 33 + if(ubound(b,1)/=ub) stop 34 + if(any(shape(b)/=[ex])) stop 35 + if(.not.checkb_p_as(b, lb, ub)) stop 36 + if(.not.allocated(b)) stop 37 + if(lbound(b,1)/=lb) stop 38 + if(ubound(b,1)/=ub) stop 39 + if(any(shape(b)/=[ex])) stop 40 + if(any(b/=u)) stop 41 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 42 + if(ubound(b,1)/=ub) stop 43 + if(any(shape(b)/=[ex])) stop 44 + if(.not.checkb_p_ar(b, lb, ub)) stop 45 + if(.not.allocated(b)) stop 46 + if(lbound(b,1)/=lb) stop 47 + if(ubound(b,1)/=ub) stop 48 + if(any(shape(b)/=[ex])) stop 49 + if(any(b/=u)) stop 50 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 51 + if(ubound(b,1)/=ub) stop 52 + if(any(shape(b)/=[ex])) stop 53 + if(.not.checkb_a_as(b, lb, ub)) stop 54 + if(.not.allocated(b)) stop 55 + if(lbound(b,1)/=lb) stop 56 + if(ubound(b,1)/=ub) stop 57 + if(any(shape(b)/=[ex])) stop 58 + if(any(b/=u)) stop 59 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 60 + if(ubound(b,1)/=ub) stop 61 + if(any(shape(b)/=[ex])) stop 62 + if(.not.checkb_a_ar(b, lb, ub)) stop 63 + if(.not.allocated(b)) stop 64 + if(lbound(b,1)/=lb) stop 65 + if(ubound(b,1)/=ub) stop 66 + if(any(shape(b)/=[ex])) stop 67 + if(any(b/=u)) stop 68 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 69 + if(ubound(b,1)/=ub) stop 70 + if(any(shape(b)/=[ex])) stop 71 + if(.not.checkb_o_as(b, 0, ex-1))stop 72 + if(.not.allocated(b)) stop 73 + if(lbound(b,1)/=lb) stop 74 + if(ubound(b,1)/=ub) stop 75 + if(any(shape(b)/=[ex])) stop 76 + if(any(b/=u)) stop 77 + ! + deallocate(b) + allocate(b(lb:ub), source=u) + if(lbound(b,1)/=lb) stop 78 + if(ubound(b,1)/=ub) stop 79 + if(any(shape(b)/=[ex])) stop 80 + if(.not.checkb_o_ar(b, 0, ex-1))stop 81 + if(.not.allocated(b)) stop 82 + if(lbound(b,1)/=lb) stop 83 + if(ubound(b,1)/=ub) stop 84 + if(any(shape(b)/=[ex])) stop 85 + if(any(b/=u)) stop 86 + deallocate(b) + ! + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 87 + if(ubound(p,1)/=ub) stop 88 + if(any(shape(p)/=[ex])) stop 89 + if(.not.checkb_p_as(p, lb, ub)) stop 90 + if(.not.associated(p)) stop 91 + if(.not.associated(p, a)) stop 92 + if(lbound(p,1)/=lb) stop 93 + if(ubound(p,1)/=ub) stop 94 + if(any(shape(p)/=[ex])) stop 95 + if(any(p/=u)) stop 96 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 97 + if(ubound(p,1)/=ub) stop 98 + if(any(shape(p)/=[ex])) stop 99 + if(.not.checkb_p_ar(p, lb, ub)) stop 100 + if(.not.associated(p)) stop 101 + if(.not.associated(p, a)) stop 102 + if(lbound(p,1)/=lb) stop 103 + if(ubound(p,1)/=ub) stop 104 + if(any(shape(p)/=[ex])) stop 105 + if(any(p/=u)) stop 106 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 107 + if(ubound(p,1)/=ub) stop 108 + if(any(shape(p)/=[ex])) stop 109 + if(.not.checkb_o_as(p, 0, ex-1))stop 110 + if(.not.associated(p)) stop 111 + if(.not.associated(p, a)) stop 112 + if(lbound(p,1)/=lb) stop 113 + if(ubound(p,1)/=ub) stop 114 + if(any(shape(p)/=[ex])) stop 115 + if(any(p/=u)) stop 116 + ! + nullify(p) + p(lb:ub) => a + if(lbound(p,1)/=lb) stop 117 + if(ubound(p,1)/=ub) stop 118 + if(any(shape(p)/=[ex])) stop 119 + if(.not.checkb_o_ar(p, 0, ex-1))stop 120 + if(.not.associated(p)) stop 121 + if(.not.associated(p, a)) stop 122 + if(lbound(p,1)/=lb) stop 123 + if(ubound(p,1)/=ub) stop 124 + if(any(shape(p)/=[ex])) stop 125 + if(any(p/=u)) stop 126 + nullify(p) + stop + +end program main_p diff --git a/gcc/testsuite/gfortran.dg/PR97046.f90 b/gcc/testsuite/gfortran.dg/PR97046.f90 new file mode 100644 index 00000000000..7d133a5ad70 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR97046.f90 @@ -0,0 +1,58 @@ +! { dg-do run } +! +! Test the fix for PR94331 +! +! Contributed by Igor Gayday <igor.gayday@mu.edu> +! + +MODULE FOO + + implicit none + + INTEGER, parameter :: n = 11 + +contains + + SUBROUTINE dummyc(x0) BIND(C) + type(*), dimension(..) :: x0 + if(LBOUND(x0,1)/=1) stop 5 + if(UBOUND(x0,1)/=n) stop 6 + if(rank(x0)/=1) stop 7 + END SUBROUTINE dummyc + + SUBROUTINE dummy(x0) + type(*), dimension(..) :: x0 + call dummyc(x0) + END SUBROUTINE dummy + +END MODULE + +PROGRAM main + USE FOO + IMPLICIT NONE + integer :: before(2), after(2) + + DOUBLE PRECISION, ALLOCATABLE :: buf(:) + DOUBLE PRECISION :: buf2(n) + + ALLOCATE(buf(n)) + before(1) = LBOUND(buf,1) + before(2) = UBOUND(buf,1) + CALL dummy (buf) + after(1) = LBOUND(buf,1) + after(2) = UBOUND(buf,1) + deallocate(buf) + + if (before(1) .NE. after(1)) stop 1 + if (before(2) .NE. after(2)) stop 2 + + before(1) = LBOUND(buf2,1) + before(2) = UBOUND(buf2,1) + CALL dummy (buf2) + after(1) = LBOUND(buf2,1) + after(2) = UBOUND(buf2,1) + + if (before(1) .NE. after(1)) stop 3 + if (before(2) .NE. after(2)) stop 4 + +END PROGRAM diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 index 00628c1247a..ede6eff67fa 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 @@ -22,4 +22,4 @@ end ! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } } ! { dg-final { scan-assembler-times "bl \.myBindC" 1 { target { powerpc-ibm-aix* } } } } ! { dg-final { scan-assembler-times "add_u32\t\[sv\]\[0-9\]*, \[sv\]\[0-9\]*, myBindC@rel32@lo" 1 { target { amdgcn*-*-* } } } } -! { dg-final { scan-tree-dump-times "cfi_desc_to_gfc_desc \\\(&parm\\." 1 "original" } } +! { dg-final { scan-tree-dump-times "gfc_desc_to_cfi_desc \\\(&cfi\\." 1 "original" } } diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 773d24e9b71..95e9b940f8e 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -43,6 +43,24 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) if (!s) return; + /* Verify descriptor. */ + switch(s->attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " + "dummy argument where the effective argument is either " + "not allocated or not associated"); + break; + default: + runtime_error ("Invalid attribute type %d in CFI_cdesc_t descriptor", + (int) s->attribute); + break; + } 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); @@ -74,14 +92,19 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) } d->offset = 0; - for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) - { - GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)s->dim[n].lower_bound; - GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent - + s->dim[n].lower_bound - 1); - 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); - } + if (GFC_DESCRIPTOR_DATA (d)) + for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) + { + CFI_index_t lb = 1; + + if (s->attribute != CFI_attribute_other) + lb = s->dim[n].lower_bound; + + GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)lb; + GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent + lb - 1); + 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); + } } extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *); @@ -102,6 +125,23 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) else d = *d_ptr; + /* Verify descriptor. */ + switch (s->dtype.attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " + "dummy argument where the effective argument is either " + "not allocated or not associated"); + break; + default: + internal_error (NULL, "Invalid attribute in gfc_array descriptor"); + break; + } d->base_addr = GFC_DESCRIPTOR_DATA (s); d->elem_len = GFC_DESCRIPTOR_SIZE (s); d->version = CFI_VERSION; ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types
@ 2021-06-03 15:04 dhumieres.dominique
2021-06-04 15:24 ` Paul Richard Thomas
0 siblings, 1 reply; 9+ messages in thread
From: dhumieres.dominique @ 2021-06-03 15:04 UTC (permalink / raw)
To: jrfsousa; +Cc: fortran, gcc-patches
Hi José,
> Patch tested only on x86_64-pc-linux-gnu.
Also tested on darwin20. The patch is OK for me.
Thanks for the work,
Dominique
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types 2021-06-03 15:04 [Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types dhumieres.dominique @ 2021-06-04 15:24 ` Paul Richard Thomas 2021-06-05 12:40 ` dhumieres.dominique 0 siblings, 1 reply; 9+ messages in thread From: Paul Richard Thomas @ 2021-06-04 15:24 UTC (permalink / raw) To: dhumieres.dominique; +Cc: José Rui Faustino de Sousa, gcc-patches, fortran Hi José, I can second Dominique's thanks. I applied it to my tree when you first posted, set the regtest in motion and have not been able to return to gfortran matters since. OK for master. I am especially happy that you have tackled this area and have rationalised it to a substantial degree. The wheel keeps being re-invented by different people, largely for a lack of documentation or coherent self-documentation. I know, as one of the guilty ones. Regards Paul On Thu, 3 Jun 2021 at 16:05, dhumieres.dominique--- via Fortran < fortran@gcc.gnu.org> wrote: > Hi José, > > > Patch tested only on x86_64-pc-linux-gnu. > > Also tested on darwin20. The patch is OK for me. > > Thanks for the work, > > Dominique > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types 2021-06-04 15:24 ` Paul Richard Thomas @ 2021-06-05 12:40 ` dhumieres.dominique 2021-06-06 17:58 ` Re:[Patch, fortran] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling dhumieres.dominique 0 siblings, 1 reply; 9+ messages in thread From: dhumieres.dominique @ 2021-06-05 12:40 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: José Rui Faustino de Sousa, gcc-patches, fortran Since the PRs are about wrong code, I think the patch should be back ported to at least GCC11. Dominique Le 2021-06-04 17:24, Paul Richard Thomas a écrit : > Hi José, > > I can second Dominique's thanks. I applied it to my tree when you > first posted, set the regtest in motion and have not been able to > return to gfortran matters since. > > OK for master. > > I am especially happy that you have tackled this area and have > rationalised it to a substantial degree. The wheel keeps being > re-invented by different people, largely for a lack of documentation > or coherent self-documentation. I know, as one of the guilty ones. > > Regards > > Paul > > On Thu, 3 Jun 2021 at 16:05, dhumieres.dominique--- via Fortran > <fortran@gcc.gnu.org> wrote: > >> Hi José, >> >>> Patch tested only on x86_64-pc-linux-gnu. >> >> Also tested on darwin20. The patch is OK for me. >> >> Thanks for the work, >> >> Dominique > > -- > "If you can't explain it simply, you don't understand it well enough" > - Albert Einstein ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re:[Patch, fortran] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-05 12:40 ` dhumieres.dominique @ 2021-06-06 17:58 ` dhumieres.dominique 2021-06-19 10:57 ` [Patch, fortran v2] " dhumieres.dominique 0 siblings, 1 reply; 9+ messages in thread From: dhumieres.dominique @ 2021-06-06 17:58 UTC (permalink / raw) To: José Rui Faustino de Sousa <jrfsousa@gmail.com>Paul Richard Thomas Cc: Paul Richard Thomas, gcc-patches, fortran Hi José, > Patch tested only on x86_64-pc-linux-gnu. Also tested on darwin20. The patch is OK for me provided the updated PR94331.c test file replaces the original one. Since the PRs are about wrong code, I think the patch should be backported to at least GCC11 (applied and regtested OK). Thanks for the work, Dominique ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran v2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling 2021-06-06 17:58 ` Re:[Patch, fortran] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling dhumieres.dominique @ 2021-06-19 10:57 ` dhumieres.dominique 0 siblings, 0 replies; 9+ messages in thread From: dhumieres.dominique @ 2021-06-19 10:57 UTC (permalink / raw) To: José Rui Faustino de Sousa <jrfsousa@gmail.com>Paul Richard Thomas Cc: gcc-patches, fortran Le 2021-06-06 19:58, dhumieres.dominique@free.fr a écrit : > Hi José, > >> Patch tested only on x86_64-pc-linux-gnu. > > Also tested on darwin20. The patch is OK for me provided the updated > PR94331.c test file replaces the original one. > Since the PRs are about wrong code, I think the patch should be > backported to at least GCC11 (applied and regtested OK). > > Thanks for the work, > > Dominique OK for the new version. Dominique ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2021-07-26 12:43 UTC | newest] Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2021-06-14 23:09 [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling José Rui Faustino de Sousa 2021-06-21 13:46 ` Tobias Burnus 2021-06-21 15:51 ` José Rui Faustino de Sousa 2021-06-21 16:46 ` Tobias Burnus 2021-06-21 17:52 ` José Rui Faustino de Sousa 2021-06-21 20:29 ` Tobias Burnus 2021-06-22 7:11 ` Tobias Burnus 2021-07-26 12:43 ` Committed: " Tobias Burnus -- strict thread matches above, loose matches on Subject: below -- 2021-06-03 15:04 [Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types dhumieres.dominique 2021-06-04 15:24 ` Paul Richard Thomas 2021-06-05 12:40 ` dhumieres.dominique 2021-06-06 17:58 ` Re:[Patch, fortran] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling dhumieres.dominique 2021-06-19 10:57 ` [Patch, fortran v2] " dhumieres.dominique
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).