+2013-04-26 Janus Weil <janus@gcc.gnu.org>
+
+ 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 <burnus@net-b.de>
PR fortran/56994
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;
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;
}
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
{
/* --------------------------------------------------------------- */
/* 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)
}
+/* 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:
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. */
/* 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. */
+2013-04-26 Janus Weil <janus@gcc.gnu.org>
+
+ 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 <polacek@redhat.com>
Backport from mainline
--- /dev/null
+! { 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 <samuel.debionne@ujf-grenoble.fr>
+
+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" } }
--- /dev/null
+! { 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 <wclodius@los-alamos.net>
+
+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 <kloedej@knmi.nl>
+
+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
projects / thirdparty / gcc.git / commitdiff
