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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [auto_char_dummy_array_1.f90] - Blame information for rev 853

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! This tests the fix for pr15809 in which automatic character length,
3
! dummy, pointer arrays were broken.
4
!
5
! contributed by Paul Thomas  
6
!
7
module global
8
  character(12), dimension(2), target :: t
9
end module global
10
 
11
program oh_no_not_pr15908_again
12
  character(12), dimension(:), pointer :: ptr
13
 
14
  call a (ptr, 12)
15
  if (.not.associated (ptr) ) call abort ()
16
  if (any (ptr.ne."abc")) call abort ()
17
 
18
  ptr => null ()              ! ptr points to 't' here.
19
  allocate (ptr(3))
20
  ptr = "xyz"
21
  call a (ptr, 12)
22
 
23
  if (.not.associated (ptr)) call abort ()
24
  if (any (ptr.ne."lmn")) call abort ()
25
 
26
  call a (ptr, 0)
27
 
28
  if (associated (ptr)) call abort ()
29
 
30
contains
31
 
32
  subroutine a (p, l)
33
    use global
34
    character(l), dimension(:), pointer :: p
35
    character(l), dimension(3)          :: s
36
 
37
    s = "lmn"
38
 
39
    if (l.ne.12) then
40
      deallocate (p)           ! ptr was allocated in main.
41
      p => null ()
42
      return
43
    end if
44
 
45
    if (.not.associated (p)) then
46
      t = "abc"
47
      p => t
48
    else
49
      if (size (p,1).ne.3) call abort ()
50
      if (any (p.ne."xyz")) call abort ()
51
      p = s
52
    end if
53
  end subroutine a
54
 
55
end program oh_no_not_pr15908_again
56
 
57
! { dg-final { cleanup-modules "global" } }

powered by: WebSVN 2.1.0

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