gcc/testsuite/gfortran.dg/pr55330.f90

   1 ! PR rtl-optimization/55330
   2 ! { dg-do compile }
   3 ! { dg-options "-O -fPIC -fno-dse -fno-guess-branch-probability" }
   4
   5 module global
   6   public    p, line
   7   interface p
   8     module procedure p
   9   end interface
  10   character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
  11 contains
  12   subroutine p()
  13     character(128) :: word
  14     word = line
  15     call redirect_((/word/))
  16   end subroutine
  17   subroutine redirect_ (ch)
  18     character(*) :: ch(:)
  19     if (ch(1) /= line) STOP 1
  20   end subroutine redirect_
  21 end module global
  22
  23 module my_module
  24   implicit none
  25   type point
  26     real :: x
  27   end type point
  28   type(point), pointer, public :: stdin => NULL()
  29 contains
  30   subroutine my_p(w)
  31     character(128) :: w
  32     call r(stdin,(/w/))
  33   end subroutine my_p
  34   subroutine r(ptr, io)
  35     use global
  36     type(point), pointer :: ptr
  37     character(128) :: io(:)
  38     if (associated (ptr)) STOP 2
  39     if (io(1) .ne. line) STOP 3
  40   end subroutine r
  41 end module my_module
  42
  43 program main
  44   use global
  45   use my_module
  46
  47   integer :: i(6) = (/1,6,3,4,5,2/)
  48   character (6) :: a = 'hello ', t
  49   character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
  50   equivalence (s, t)
  51
  52   call option_stopwatch_s (a)
  53   call p ()
  54   call my_p (line)
  55
  56   s = s(i)
  57   call option_stopwatch_a ((/a,'hola! ', t/))
  58
  59 contains
  60
  61   subroutine option_stopwatch_s(a)
  62     character (*), intent(in) :: a
  63     character (len=len(a)) :: b
  64
  65     b = 'hola! '
  66     call option_stopwatch_a((/a, b, 'goddag'/))
  67   end subroutine option_stopwatch_s
  68   subroutine option_stopwatch_a (a)
  69     character (*) :: a(:)
  70     if (any (a .ne. (/'hello ','hola! ','goddag'/))) STOP 4
  71   end subroutine option_stopwatch_a
  72
  73 end program main