Dear All,

This patch addresses issues arising from PR57893.  It is entirely obvious.

Bootstraps and regtests on FC17/x86_64 - OK for trunk?

Cheers

Paul

PS I wash my hands of all attempts to use BT_HOLLERITH types!

2013-10-29  Paul Thomas  <pa...@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  <pa...@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.
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c	(revision 204135)
--- gcc/fortran/trans-types.c	(working copy)
*************** gfc_typenode_for_spec (gfc_typespec * sp
*** 1099,1104 ****
--- 1099,1110 ----
  	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);
Index: gcc/fortran/target-memory.c
===================================================================
*** gcc/fortran/target-memory.c	(revision 204135)
--- gcc/fortran/target-memory.c	(working copy)
*************** gfc_element_size (gfc_expr *e)
*** 109,114 ****
--- 109,116 ----
        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.  */
Index: gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90
===================================================================
*** gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90	(revision 204135)
--- gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90	(working copy)
*************** module m
*** 13,18 ****
--- 13,22 ----
    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
*************** contains
*** 21,31 ****
  
      select case (k)
       case (4)
!       sz = 32*2
       case (8)
!       sz = 64*2
!      case (10,16)
!       sz = 128*2
       case default
         call abort()
      end select
--- 25,37 ----
  
      select case (k)
       case (4)
!       sz = storage_size(r1)*2
       case (8)
!       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
*************** contains
*** 36,43 ****
          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))
--- 42,47 ----
Index: gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90
===================================================================
*** gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90	(working copy)
***************
*** 0 ****
--- 1,26 ----
+ ! { dg-do run }
+ !
+ ! Uncovered in fixing PR fortran/58793
+ !
+ ! Contributed by Tobias Burnus  <bur...@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

Reply via email to