From: Janus Weil Date: Fri, 26 Apr 2013 22:26:02 +0000 (+0200) Subject: Backport PRs 53685, 56968, 57022 X-Git-Tag: releases/gcc-4.7.4~698 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ca8b59b64fb0ae4476894267c41ef2a67a94ab50;p=thirdparty%2Fgcc.git Backport PRs 53685, 56968, 57022 2013-04-26 Janus Weil Backports from trunk: PR fortran/56968 * expr.c (gfc_check_pointer_assign): Handle generic functions returning procedure pointers. PR fortran/53685 PR fortran/57022 * check.c (gfc_calculate_transfer_sizes): Fix for array-valued SOURCE expressions. * target-memory.h (gfc_element_size): New prototype. * target-memory.c (size_array): Remove. (gfc_element_size): New function. (gfc_target_expr_size): Modified to always return the full size of the expression. 2013-04-26 Janus Weil Backports from trunk: PR fortran/56968 * gfortran.dg/proc_ptr_41.f90: New. PR fortran/53685 PR fortran/57022 * gfortran.dg/transfer_check_4.f90: New. From-SVN: r198348 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 13e251a31705..af2c5dc6d045 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2013-04-26 Janus Weil + + Backports from trunk: + + PR fortran/56968 + * expr.c (gfc_check_pointer_assign): Handle generic functions returning + procedure pointers. + + PR fortran/53685 + PR fortran/57022 + * check.c (gfc_calculate_transfer_sizes): Fix for array-valued SOURCE + expressions. + * target-memory.h (gfc_element_size): New prototype. + * target-memory.c (size_array): Remove. + (gfc_element_size): New function. + (gfc_target_expr_size): Modified to always return the full size of the + expression. + 2013-04-18 Tobias Burnus PR fortran/56994 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index d69ba8863738..f6195aa8b3a0 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3988,8 +3988,6 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, size_t *result_length_p) { size_t result_elt_size; - mpz_t tmp; - gfc_expr *mold_element; if (source->expr_type == EXPR_FUNCTION) return FAILURE; @@ -3998,20 +3996,12 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, return FAILURE; /* Calculate the size of the source. */ - if (source->expr_type == EXPR_ARRAY - && gfc_array_size (source, &tmp) == FAILURE) - return FAILURE; - *source_size = gfc_target_expr_size (source); if (*source_size == 0) return FAILURE; - mold_element = mold->expr_type == EXPR_ARRAY - ? gfc_constructor_first (mold->value.constructor)->expr - : mold; - /* Determine the size of the element. */ - result_elt_size = gfc_target_expr_size (mold_element); + result_elt_size = gfc_element_size (mold); if (result_elt_size == 0) return FAILURE; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 0ad7f7b5b9ee..194deb6fb2b1 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3493,8 +3493,12 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } else if (rvalue->expr_type == EXPR_FUNCTION) { - s2 = rvalue->symtree->n.sym->result; - name = rvalue->symtree->n.sym->result->name; + if (rvalue->value.function.esym) + s2 = rvalue->value.function.esym->result; + else + s2 = rvalue->symtree->n.sym->result; + + name = s2->name; } else { diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 213ee52d307f..077c829bac71 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -35,16 +35,6 @@ along with GCC; see the file COPYING3. If not see /* --------------------------------------------------------------- */ /* Calculate the size of an expression. */ -static size_t -size_array (gfc_expr *e) -{ - mpz_t array_size; - gfc_constructor *c = gfc_constructor_first (e->value.constructor); - size_t elt_size = gfc_target_expr_size (c->expr); - - gfc_array_size (e, &array_size); - return (size_t)mpz_get_ui (array_size) * elt_size; -} static size_t size_integer (int kind) @@ -82,16 +72,14 @@ size_character (int length, int kind) } +/* Return the size of a single element of the given expression. + Identical to gfc_target_expr_size for scalars. */ + size_t -gfc_target_expr_size (gfc_expr *e) +gfc_element_size (gfc_expr *e) { tree type; - gcc_assert (e != NULL); - - if (e->expr_type == EXPR_ARRAY) - return size_array (e); - switch (e->ts.type) { case BT_INTEGER: @@ -130,12 +118,36 @@ gfc_target_expr_size (gfc_expr *e) return int_size_in_bytes (type); } default: - gfc_internal_error ("Invalid expression in gfc_target_expr_size."); + gfc_internal_error ("Invalid expression in gfc_element_size."); return 0; } } +/* Return the size of an expression in its target representation. */ + +size_t +gfc_target_expr_size (gfc_expr *e) +{ + mpz_t tmp; + size_t asz; + + gcc_assert (e != NULL); + + if (e->rank) + { + if (gfc_array_size (e, &tmp)) + asz = mpz_get_ui (tmp); + else + asz = 0; + } + else + asz = 1; + + return asz * gfc_element_size (e); +} + + /* The encode_* functions export a value into a buffer, and return the number of bytes of the buffer that have been used. */ diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index 6ebffe86521e..660ab8083d9e 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see /* Convert a BOZ to REAL or COMPLEX. */ bool gfc_convert_boz (gfc_expr *, gfc_typespec *); -/* Return the size of an expression in its target representation. */ +size_t gfc_element_size (gfc_expr *); size_t gfc_target_expr_size (gfc_expr *); /* Write a constant expression in binary form to a target buffer. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a719d45e8f4a..0da9878892d4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2013-04-26 Janus Weil + + Backports from trunk: + + PR fortran/56968 + * gfortran.dg/proc_ptr_41.f90: New. + + PR fortran/53685 + PR fortran/57022 + * gfortran.dg/transfer_check_4.f90: New. + 2013-04-19 Marek Polacek Backport from mainline diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_41.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_41.f90 new file mode 100644 index 000000000000..7f50abab21a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_41.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +! +! PR 56968: [4.7/4.8/4.9 Regression] [F03] Issue with a procedure defined with a generic name returning procedure pointer +! +! Contributed by Samuel Debionne + +module test + + interface generic_name_get_proc_ptr + module procedure specific_name_get_proc_ptr + end interface + + abstract interface + double precision function foo(arg1) + real, intent(in) :: arg1 + end function + end interface + +contains + + function specific_name_get_proc_ptr() result(res) + procedure(foo), pointer :: res + end function + +end module test + +program crash_test + use :: test + + procedure(foo), pointer :: ptr + + ptr => specific_name_get_proc_ptr() + ptr => generic_name_get_proc_ptr() + +end program + +! { dg-final { cleanup-modules "test" } } diff --git a/gcc/testsuite/gfortran.dg/transfer_check_4.f90 b/gcc/testsuite/gfortran.dg/transfer_check_4.f90 new file mode 100644 index 000000000000..030d3454909e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_check_4.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! { dg-options "-Wall" } + +! PR 57022: [4.7/4.8/4.9 Regression] Inappropriate warning for use of TRANSFER with arrays +! Contributed by William Clodius + +subroutine transfers (test) + + use, intrinsic :: iso_fortran_env + + integer, intent(in) :: test + + integer(int8) :: test8(8) = 0 + integer(int16) :: test16(4) = 0 + integer(int32) :: test32(2) = 0 + integer(int64) :: test64 = 0 + + select case(test) + case(0) + test64 = transfer(test8, test64) + case(1) + test64 = transfer(test16, test64) + case(2) + test64 = transfer(test32, test64) + case(3) + test8 = transfer(test64, test8, 8) + case(4) + test16 = transfer(test64, test16, 4) + case(5) + test32 = transfer(test64, test32, 2) + end select + +end subroutine + + +! PR 53685: surprising warns about transfer with explicit character range +! Contributed by Jos de Kloe + +subroutine mytest(byte_array,val) + integer, parameter :: r8_ = Selected_Real_Kind(15,307) ! = real*8 + character(len=1), dimension(16), intent(in) :: byte_array + real(r8_),intent(out) :: val + val = transfer(byte_array(1:8),val) +end subroutine