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

PR fortran 57893

Browse Source 
2013-10-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran 57893
	* trans-types.c (gfc_typenode_for_spec): Add typenode for
	BT_HOLLERITH. Note that the length is incorrect but unusable.

	PR fortran 58858
	* target-memory.c (gfc_element_size): Add element sizes for
	BT_VOID and BT_ASSUMED, using gfc_typenode_for_spec.

2013-10-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran 57893
	* gfortran.dg/unlimited_polymorphic_13.f90 : Use real variables
	to determine sizes of real kinds.

	PR fortran 58858
	* gfortran.dg/unlimited_polymorphic_14.f90 : New test.

From-SVN: r204177
This commit is contained in:
Paul Thomas 2013-10-29 20:30:51 +00:00
parent d19245aa46
commit 258125712b
6 changed files with 77 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2013-10-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran 57893
* trans-types.c (gfc_typenode_for_spec): Add typenode for
BT_HOLLERITH. Note that the length is incorrect but unusable.
PR fortran 58858
* target-memory.c (gfc_element_size): Add element sizes for
BT_VOID and BT_ASSUMED, using gfc_typenode_for_spec.
2013-10-24 Tobias Burnus <burnus@net-b.de>
PR fortran/44646

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

@ -32,7 +32,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-types.h"
#include "target-memory.h"
/* --------------------------------------------------------------- */
/* --------------------------------------------------------------- */
/* Calculate the size of an expression. */
@ -109,6 +109,8 @@ gfc_element_size (gfc_expr *e)
return e->representation.length;
case BT_DERIVED:
case BT_CLASS:
case BT_VOID:
case BT_ASSUMED:
{
/* Determine type size without clobbering the typespec for ISO C
binding types. */
@ -151,7 +153,7 @@ gfc_target_expr_size (gfc_expr *e)
}
/* The encode_* functions export a value into a buffer, and
/* The encode_* functions export a value into a buffer, and
return the number of bytes of the buffer that have been
used. */
@ -286,7 +288,7 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
|| source->expr_type == EXPR_STRUCTURE
|| source->expr_type == EXPR_SUBSTRING);
/* If we already have a target-memory representation, we use that rather
/* If we already have a target-memory representation, we use that rather
than recreating one. */
if (source->representation.string)
{
@ -496,7 +498,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
/* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
sets this to BT_INTEGER. */
result->ts.type = BT_DERIVED;
e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where);
e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where);
c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
c->n.component = cmp;
gfc_target_interpret_expr (buffer, buffer_size, e, true);
@ -511,7 +513,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
{
gfc_constructor *c;
gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
&result->where);
&result->where);
e->ts = cmp->ts;
/* Copy shape, if needed. */
@ -551,7 +553,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, true);
}
return int_size_in_bytes (type);
}
@ -567,31 +569,31 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
switch (result->ts.type)
{
case BT_INTEGER:
result->representation.length =
result->representation.length =
gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
result->value.integer);
break;
case BT_REAL:
result->representation.length =
result->representation.length =
gfc_interpret_float (result->ts.kind, buffer, buffer_size,
result->value.real);
break;
case BT_COMPLEX:
result->representation.length =
result->representation.length =
gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
result->value.complex);
break;
case BT_LOGICAL:
result->representation.length =
result->representation.length =
gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
&result->value.logical);
break;
case BT_CHARACTER:
result->representation.length =
result->representation.length =
gfc_interpret_character (buffer, buffer_size, result);
break;
@ -599,7 +601,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
result->ts = CLASS_DATA (result)->ts;
/* Fall through. */
case BT_DERIVED:
result->representation.length =
result->representation.length =
gfc_interpret_derived (buffer, buffer_size, result);
gcc_assert (result->representation.length >= 0);
break;
@ -626,7 +628,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
}
/* --------------------------------------------------------------- */
/* --------------------------------------------------------------- */
/* Two functions used by trans-common.c to write overlapping
equivalence initializers to a buffer. This is added to the union
and the original initializers freed. */
@ -791,7 +793,7 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
gfc_interpret_complex (ts->kind, buffer, buffer_size,
expr->value.complex);
}
expr->is_boz = 0;
expr->is_boz = 0;
expr->ts.type = ts->type;
expr->ts.kind = ts->kind;

6
gcc/fortran/trans-types.c
View File

@ -1099,6 +1099,12 @@ gfc_typenode_for_spec (gfc_typespec * spec)
basetype = gfc_get_character_type (spec->kind, spec->u.cl);
break;
case BT_HOLLERITH:
/* Since this cannot be used, return a length one character. */
basetype = gfc_get_character_type_len (gfc_default_character_kind,
gfc_index_one_node);
break;
case BT_DERIVED:
case BT_CLASS:
basetype = gfc_get_derived_type (spec->u.derived);

9
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,12 @@
2013-10-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran 57893
* gfortran.dg/unlimited_polymorphic_13.f90 : Use real variables
to determine sizes of real kinds.
PR fortran 58858
* gfortran.dg/unlimited_polymorphic_14.f90 : New test.
2013-10-29 Balaji V. Iyer <balaji.v.iyer@intel.com>
* c-c++-common/cilk-plus/CK/compound_cilk_spawn.c: New test.

16
gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90
View File

@ -13,6 +13,10 @@ module m
integer, parameter :: c2 = real_kinds(2)
integer, parameter :: c3 = real_kinds(size(real_kinds)-1)
integer, parameter :: c4 = real_kinds(size(real_kinds))
real(c1) :: r1
real(c2) :: r2
real(c3) :: r3
real(c4) :: r4
contains
subroutine s(o, k)
class(*) :: o
@ -21,11 +25,13 @@ contains
select case (k)
case (4)
sz = 32*2
sz = storage_size(r1)*2
case (8)
sz = 64*2
case (10,16)
sz = 128*2
sz = storage_size(r2)*2
case (10)
sz = storage_size(r3)*2
case (16)
sz = storage_size(r4)*2
case default
call abort()
end select
@ -36,8 +42,6 @@ contains
if (storage_size(o) /= sz) call abort()
type is (complex(c2))
if (storage_size(o) /= sz) call abort()
end select
select type (o)
type is (complex(c3))
if (storage_size(o) /= sz) call abort()
type is (complex(c4))

26
gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do run }
!
! Uncovered in fixing PR fortran/58793
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
! Barfed on the hollerith argument
!
program test
logical l
call up("abc", l)
if (l) call abort
call up(3habc, l) ! { dg-warning "Legacy Extension" }
if (.not. l) call abort
contains
subroutine up(x, l)
class(*) :: x
logical l
select type(x)
type is (character(*))
l = .false.
class default
l = .true.
end select
end subroutine
end program test