diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 80697ff98d0..86ce782a005 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2013-10-29 Paul Thomas + + 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 PR fortran/44646 diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 21b44ae482f..e905b3a67dc 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -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; diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 806accc7015..fa84d5dab81 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 621b951bfa3..1d18289397f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2013-10-29 Paul Thomas + + 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 * c-c++-common/cilk-plus/CK/compound_cilk_spawn.c: New test. diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90 index 8b764959c7e..10f644535b2 100644 --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90 +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90 @@ -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)) diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90 new file mode 100644 index 00000000000..215b03f64ee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! +! Uncovered in fixing PR fortran/58793 +! +! Contributed by Tobias Burnus +! +! 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