OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [alloc_comp_assign_6.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Tests the fix for pr32880, in which 'res' was deallocated
3
! before it could be used in the concatenation.
4
! Adapted from vst28.f95, in Lawrie Schonfeld's iso_varying_string
5
! testsuite, by Tobias Burnus.
6
!
7
module iso_varying_string
8
  type varying_string
9
     character(LEN=1), dimension(:), allocatable :: chars
10
  end type varying_string
11
  interface assignment(=)
12
     module procedure op_assign_VS_CH
13
  end interface assignment(=)
14
  interface operator(//)
15
     module procedure op_concat_VS_CH
16
  end interface operator(//)
17
contains
18
  elemental subroutine op_assign_VS_CH (var, exp)
19
    type(varying_string), intent(out) :: var
20
    character(LEN=*), intent(in)      :: exp
21
    integer                      :: length
22
    integer                      :: i_char
23
    length = len(exp)
24
    allocate(var%chars(length))
25
    forall(i_char = 1:length)
26
       var%chars(i_char) = exp(i_char:i_char)
27
    end forall
28
  end subroutine op_assign_VS_CH
29
  elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)
30
    type(varying_string), intent(in) :: string_a
31
    character(LEN=*), intent(in)     :: string_b
32
    type(varying_string)             :: concat_string
33
    len_string_a = size(string_a%chars)
34
    allocate(concat_string%chars(len_string_a+len(string_b)))
35
    if (len_string_a >0) &
36
       concat_string%chars(:len_string_a) = string_a%chars
37
    if (len (string_b) > 0) &
38
       concat_string%chars(len_string_a+1:) = string_b
39
  end function op_concat_VS_CH
40
end module iso_varying_string
41
 
42
program VST28
43
  use iso_varying_string
44
  character(len=10) :: char_a
45
  type(VARYING_STRING) :: res
46
  char_a = "abcdefghij"
47
  res = char_a(5:5)
48
  res = res//char_a(6:6)
49
  if(size(res%chars) /= 2 .or. any(res%chars /= ['e','f'])) then
50
    write(*,*) 'ERROR: should be ef, got: ', res%chars, size(res%chars)
51
    call abort ()
52
  end if
53
end program VST28
54
 
55
! { dg-final { cleanup-modules "iso_varying_string" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.