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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [actual_array_constructor_1.f90] - Diff between revs 154 and 816

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 154 Rev 816
! { dg-do run }
! { dg-do run }
! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
! that arose from a character array constructor usedas an actual
! that arose from a character array constructor usedas an actual
! argument.
! argument.
!
!
! The various parts of this test are taken from the PRs.
! The various parts of this test are taken from the PRs.
!
!
! Test PR26491
! Test PR26491
module global
module global
  public    p, line
  public    p, line
  interface p
  interface p
    module procedure p
    module procedure p
  end interface
  end interface
  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
contains
contains
  subroutine p()
  subroutine p()
    character(128) :: word
    character(128) :: word
    word = line
    word = line
    call redirect_((/word/))
    call redirect_((/word/))
  end subroutine
  end subroutine
  subroutine redirect_ (ch)
  subroutine redirect_ (ch)
    character(*) :: ch(:)
    character(*) :: ch(:)
    if (ch(1) /= line) call abort ()
    if (ch(1) /= line) call abort ()
  end subroutine redirect_
  end subroutine redirect_
end module global
end module global
! Test PR26550
! Test PR26550
module my_module
module my_module
  implicit none
  implicit none
  type point
  type point
    real :: x
    real :: x
  end type point
  end type point
  type(point), pointer, public :: stdin => NULL()
  type(point), pointer, public :: stdin => NULL()
contains
contains
  subroutine my_p(w)
  subroutine my_p(w)
    character(128) :: w
    character(128) :: w
    call r(stdin,(/w/))
    call r(stdin,(/w/))
  end subroutine my_p
  end subroutine my_p
  subroutine r(ptr, io)
  subroutine r(ptr, io)
    use global
    use global
    type(point), pointer :: ptr
    type(point), pointer :: ptr
    character(128) :: io(:)
    character(128) :: io(:)
    if (associated (ptr)) call abort ()
    if (associated (ptr)) call abort ()
    if (io(1) .ne. line) call abort ()
    if (io(1) .ne. line) call abort ()
  end subroutine r
  end subroutine r
end module my_module
end module my_module
program main
program main
  use global
  use global
  use my_module
  use my_module
  integer :: i(6) = (/1,6,3,4,5,2/)
  integer :: i(6) = (/1,6,3,4,5,2/)
  character (6) :: a = 'hello ', t
  character (6) :: a = 'hello ', t
  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
  equivalence (s, t)
  equivalence (s, t)
  call option_stopwatch_s (a) ! Call test of PR25619
  call option_stopwatch_s (a) ! Call test of PR25619
  call p ()                   ! Call test of PR26491
  call p ()                   ! Call test of PR26491
  call my_p (line)            ! Call test of PR26550
  call my_p (line)            ! Call test of PR26550
! Test Vivek Rao's bug, as reported in PR25619.
! Test Vivek Rao's bug, as reported in PR25619.
  s = s(i)
  s = s(i)
  call option_stopwatch_a ((/a,'hola! ', t/))
  call option_stopwatch_a ((/a,'hola! ', t/))
contains
contains
! Test PR23634
! Test PR23634
  subroutine option_stopwatch_s(a)
  subroutine option_stopwatch_s(a)
    character (*), intent(in) :: a
    character (*), intent(in) :: a
    character (len=len(a)) :: b
    character (len=len(a)) :: b
    b = 'hola! '
    b = 'hola! '
    call option_stopwatch_a((/a, b, 'goddag'/))
    call option_stopwatch_a((/a, b, 'goddag'/))
  end subroutine option_stopwatch_s
  end subroutine option_stopwatch_s
  subroutine option_stopwatch_a (a)
  subroutine option_stopwatch_a (a)
    character (*) :: a(:)
    character (*) :: a(:)
    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
  end subroutine option_stopwatch_a
  end subroutine option_stopwatch_a
end program main
end program main
! { dg-final { cleanup-modules "global my_module" } }
! { dg-final { cleanup-modules "global my_module" } }
 
 

powered by: WebSVN 2.1.0

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