Commit 25812571 by Paul Thomas

PR fortran 57893

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
parent d19245aa
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> 2013-10-24 Tobias Burnus <burnus@net-b.de>
PR fortran/44646 PR fortran/44646
......
...@@ -32,7 +32,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -32,7 +32,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-types.h" #include "trans-types.h"
#include "target-memory.h" #include "target-memory.h"
/* --------------------------------------------------------------- */ /* --------------------------------------------------------------- */
/* Calculate the size of an expression. */ /* Calculate the size of an expression. */
...@@ -109,6 +109,8 @@ gfc_element_size (gfc_expr *e) ...@@ -109,6 +109,8 @@ gfc_element_size (gfc_expr *e)
return e->representation.length; return e->representation.length;
case BT_DERIVED: case BT_DERIVED:
case BT_CLASS: case BT_CLASS:
case BT_VOID:
case BT_ASSUMED:
{ {
/* Determine type size without clobbering the typespec for ISO C /* Determine type size without clobbering the typespec for ISO C
binding types. */ binding types. */
...@@ -151,7 +153,7 @@ gfc_target_expr_size (gfc_expr *e) ...@@ -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 return the number of bytes of the buffer that have been
used. */ used. */
...@@ -286,7 +288,7 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, ...@@ -286,7 +288,7 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
|| source->expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_STRUCTURE
|| source->expr_type == EXPR_SUBSTRING); || 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. */ than recreating one. */
if (source->representation.string) if (source->representation.string)
{ {
...@@ -496,7 +498,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu ...@@ -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 /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
sets this to BT_INTEGER. */ sets this to BT_INTEGER. */
result->ts.type = BT_DERIVED; 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 = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
c->n.component = cmp; c->n.component = cmp;
gfc_target_interpret_expr (buffer, buffer_size, e, true); 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 ...@@ -511,7 +513,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
{ {
gfc_constructor *c; gfc_constructor *c;
gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
&result->where); &result->where);
e->ts = cmp->ts; e->ts = cmp->ts;
/* Copy shape, if needed. */ /* Copy shape, if needed. */
...@@ -551,7 +553,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu ...@@ -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); gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, true);
} }
return int_size_in_bytes (type); return int_size_in_bytes (type);
} }
...@@ -567,31 +569,31 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, ...@@ -567,31 +569,31 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
switch (result->ts.type) switch (result->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
result->representation.length = result->representation.length =
gfc_interpret_integer (result->ts.kind, buffer, buffer_size, gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
result->value.integer); result->value.integer);
break; break;
case BT_REAL: case BT_REAL:
result->representation.length = result->representation.length =
gfc_interpret_float (result->ts.kind, buffer, buffer_size, gfc_interpret_float (result->ts.kind, buffer, buffer_size,
result->value.real); result->value.real);
break; break;
case BT_COMPLEX: case BT_COMPLEX:
result->representation.length = result->representation.length =
gfc_interpret_complex (result->ts.kind, buffer, buffer_size, gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
result->value.complex); result->value.complex);
break; break;
case BT_LOGICAL: case BT_LOGICAL:
result->representation.length = result->representation.length =
gfc_interpret_logical (result->ts.kind, buffer, buffer_size, gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
&result->value.logical); &result->value.logical);
break; break;
case BT_CHARACTER: case BT_CHARACTER:
result->representation.length = result->representation.length =
gfc_interpret_character (buffer, buffer_size, result); gfc_interpret_character (buffer, buffer_size, result);
break; break;
...@@ -599,7 +601,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, ...@@ -599,7 +601,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
result->ts = CLASS_DATA (result)->ts; result->ts = CLASS_DATA (result)->ts;
/* Fall through. */ /* Fall through. */
case BT_DERIVED: case BT_DERIVED:
result->representation.length = result->representation.length =
gfc_interpret_derived (buffer, buffer_size, result); gfc_interpret_derived (buffer, buffer_size, result);
gcc_assert (result->representation.length >= 0); gcc_assert (result->representation.length >= 0);
break; break;
...@@ -626,7 +628,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, ...@@ -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 /* Two functions used by trans-common.c to write overlapping
equivalence initializers to a buffer. This is added to the union equivalence initializers to a buffer. This is added to the union
and the original initializers freed. */ and the original initializers freed. */
...@@ -791,7 +793,7 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) ...@@ -791,7 +793,7 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
gfc_interpret_complex (ts->kind, buffer, buffer_size, gfc_interpret_complex (ts->kind, buffer, buffer_size,
expr->value.complex); expr->value.complex);
} }
expr->is_boz = 0; expr->is_boz = 0;
expr->ts.type = ts->type; expr->ts.type = ts->type;
expr->ts.kind = ts->kind; expr->ts.kind = ts->kind;
......
...@@ -1099,6 +1099,12 @@ gfc_typenode_for_spec (gfc_typespec * spec) ...@@ -1099,6 +1099,12 @@ gfc_typenode_for_spec (gfc_typespec * spec)
basetype = gfc_get_character_type (spec->kind, spec->u.cl); basetype = gfc_get_character_type (spec->kind, spec->u.cl);
break; 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_DERIVED:
case BT_CLASS: case BT_CLASS:
basetype = gfc_get_derived_type (spec->u.derived); basetype = gfc_get_derived_type (spec->u.derived);
......
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> 2013-10-29 Balaji V. Iyer <balaji.v.iyer@intel.com>
* c-c++-common/cilk-plus/CK/compound_cilk_spawn.c: New test. * c-c++-common/cilk-plus/CK/compound_cilk_spawn.c: New test.
......
...@@ -13,6 +13,10 @@ module m ...@@ -13,6 +13,10 @@ module m
integer, parameter :: c2 = real_kinds(2) integer, parameter :: c2 = real_kinds(2)
integer, parameter :: c3 = real_kinds(size(real_kinds)-1) integer, parameter :: c3 = real_kinds(size(real_kinds)-1)
integer, parameter :: c4 = real_kinds(size(real_kinds)) integer, parameter :: c4 = real_kinds(size(real_kinds))
real(c1) :: r1
real(c2) :: r2
real(c3) :: r3
real(c4) :: r4
contains contains
subroutine s(o, k) subroutine s(o, k)
class(*) :: o class(*) :: o
...@@ -21,11 +25,13 @@ contains ...@@ -21,11 +25,13 @@ contains
select case (k) select case (k)
case (4) case (4)
sz = 32*2 sz = storage_size(r1)*2
case (8) case (8)
sz = 64*2 sz = storage_size(r2)*2
case (10,16) case (10)
sz = 128*2 sz = storage_size(r3)*2
case (16)
sz = storage_size(r4)*2
case default case default
call abort() call abort()
end select end select
...@@ -36,8 +42,6 @@ contains ...@@ -36,8 +42,6 @@ contains
if (storage_size(o) /= sz) call abort() if (storage_size(o) /= sz) call abort()
type is (complex(c2)) type is (complex(c2))
if (storage_size(o) /= sz) call abort() if (storage_size(o) /= sz) call abort()
end select
select type (o)
type is (complex(c3)) type is (complex(c3))
if (storage_size(o) /= sz) call abort() if (storage_size(o) /= sz) call abort()
type is (complex(c4)) type is (complex(c4))
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment