view gcc/testsuite/gfortran.dg/pr55330.f90 @ 144:8f4e72ab4e11

fix segmentation fault caused by nothing next cur_op to end
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 21:23:56 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! PR rtl-optimization/55330
! { dg-do compile }
! { dg-options "-O -fPIC -fno-dse -fno-guess-branch-probability" }

module global
  public    p, line
  interface p
    module procedure p
  end interface
  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
contains
  subroutine p()
    character(128) :: word
    word = line
    call redirect_((/word/))
  end subroutine
  subroutine redirect_ (ch)
    character(*) :: ch(:)
    if (ch(1) /= line) STOP 1
  end subroutine redirect_
end module global

module my_module
  implicit none
  type point
    real :: x
  end type point
  type(point), pointer, public :: stdin => NULL()
contains
  subroutine my_p(w)
    character(128) :: w
    call r(stdin,(/w/))
  end subroutine my_p
  subroutine r(ptr, io)
    use global
    type(point), pointer :: ptr
    character(128) :: io(:)
    if (associated (ptr)) STOP 2
    if (io(1) .ne. line) STOP 3
  end subroutine r
end module my_module

program main
  use global
  use my_module

  integer :: i(6) = (/1,6,3,4,5,2/)
  character (6) :: a = 'hello ', t
  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
  equivalence (s, t)

  call option_stopwatch_s (a)
  call p ()
  call my_p (line)

  s = s(i)
  call option_stopwatch_a ((/a,'hola! ', t/))

contains

  subroutine option_stopwatch_s(a)
    character (*), intent(in) :: a
    character (len=len(a)) :: b

    b = 'hola! '
    call option_stopwatch_a((/a, b, 'goddag'/))
  end subroutine option_stopwatch_s 
  subroutine option_stopwatch_a (a)
    character (*) :: a(:)
    if (any (a .ne. (/'hello ','hola! ','goddag'/))) STOP 4
  end subroutine option_stopwatch_a

end program main