The attached patch allows gfortran to compile the
attached testcase.  The resulting executable runs
as expected.

Short story:  

  character(len=20) :: string = 'some text here'
  character(len=:), allocatable :: s
  n = 5
  allocate(s, source=string(:n))

The length of s is determined from the expression in
the source= argument.  If this expression is a lonely
substring reference as in the above, then gfortran 
does set the correct length.  This patch fixes this.

OK for trunk?

2011-08-26  Steven G. Kargl  <ka...@gcc.gnu.org>

        PR fortran/45170
        * trans-stmt.c (gfc_trans_allocate): Evaluate the substring.

2011-08-26  Steven G. Kargl  <ka...@gcc.gnu.org>

        PR fortran/45170
        * gfortran.dg/allocate_with_source_2.f90: New test
-- 
Steve
Index: trans-stmt.c
===================================================================
--- trans-stmt.c	(revision 177772)
+++ trans-stmt.c	(working copy)
@@ -4783,6 +4783,10 @@ gfc_trans_allocate (gfc_code * code)
 			|| code->expr3->expr_type == EXPR_CONSTANT)
 		    {
 		      gfc_conv_expr (&se_sz, code->expr3);
+		      gfc_add_block_to_block (&se.pre, &se_sz.pre);
+		      se_sz.string_length
+			= gfc_evaluate_now (se_sz.string_length, &se.pre);
+		      gfc_add_block_to_block (&se.pre, &se_sz.post);
 		      memsz = se_sz.string_length;
 		    }
 		  else if (code->expr3->mold
! { dg-do run }
! PR 45170
! A variation of a theme for deferred type parameters.  The
! substring reference in the source= portion of the allocate
! was not probably resolved.  Testcase is a modified version
! of a program due to Hans-Werner Boschmann <boschmann at tp1
! dot physik dot uni-siegen dot de>
!
program helloworld
  character(:),allocatable::string
  real::rnd
  call hello(5, string)
  if (string /= 'hello' .or. len(string) /= 5) call abort
contains
  subroutine hello (n,string)
    character(:),allocatable,intent(out)::string
    integer,intent(in)::n
    character(20)::helloworld="hello world"
   allocate(string, source=helloworld(:n))
  end subroutine hello
end program helloworld

Reply via email to