OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Backport PRs 53685, 56968, 57022 

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-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.

From-SVN: r198348
This commit is contained in:
Janus Weil 2013-04-27 00:26:02 +02:00
parent ee803b920c
commit ca8b59b64f
8 changed files with 147 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/fortran/ChangeLog
View File

@ -1,3 +1,21 @@
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

12
gcc/fortran/check.c
View File

@ -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;

8
gcc/fortran/expr.c
View File

@ -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
{

46
gcc/fortran/target-memory.c
View File

@ -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. */

2
gcc/fortran/target-memory.h
View File

@ -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. */

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
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

37
gcc/testsuite/gfortran.dg/proc_ptr_41.f90 Normal file
View File

@ -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 <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" } }

44
gcc/testsuite/gfortran.dg/transfer_check_4.f90 Normal file
View File

@ -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 <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