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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 80697ff98d0a775fae879c8f680e7aac5fb51d76..86ce782a005797fee3cec341f61e8714915989c7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 21b44ae482ffcb674556d58cae9e8287be115418..e905b3a67dcb503894826893343ed3f7be91719b 100644 (file)
--- 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 806accc7015a76ca05fe05edfe03cdfad6b70fe2..fa84d5dab8154d1b5083bebb1ade09b26e1aa107 100644 (file)
--- 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 621b951bfa3f17ff8933348f5ed420bf9bb7977c..1d18289397f4367a046a07840f3e371aa38d8e74 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90
index 8b764959c7eec3e1dc56ff4b1ee34f0d147ca96e..10f644535b2c06244947b1c09f7cb1cc4a6508b3 100644 (file)
--- 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 (file)
index 0000000..215b03f
--- /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  <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