gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90

   1 ! { dg-do run }
   2 ! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
   3 ! that arose from a character array constructor usedas an actual
   4 ! argument.
   5 !
   6 ! The various parts of this test are taken from the PRs.
   7 !
   8 ! Test PR26491
   9 module global
  10   public    p, line
  11   interface p
  12     module procedure p
  13   end interface
  14   character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
  15 contains
  16   subroutine p()
  17     character(128) :: word
  18     word = line
  19     call redirect_((/word/))
  20   end subroutine
  21   subroutine redirect_ (ch)
  22     character(*) :: ch(:)
  23     if (ch(1) /= line) call abort ()
  24   end subroutine redirect_
  25 end module global
  26
  27 ! Test PR26550
  28 module my_module
  29   implicit none
  30   type point
  31     real :: x
  32   end type point
  33   type(point), pointer, public :: stdin => NULL()
  34 contains
  35   subroutine my_p(w)
  36     character(128) :: w
  37     call r(stdin,(/w/))
  38   end subroutine my_p
  39   subroutine r(ptr, io)
  40     use global
  41     type(point), pointer :: ptr
  42     character(128) :: io(:)
  43     if (associated (ptr)) call abort ()
  44     if (io(1) .ne. line) call abort ()
  45   end subroutine r
  46 end module my_module
  47
  48 program main
  49   use global
  50   use my_module
  51
  52   integer :: i(6) = (/1,6,3,4,5,2/)
  53   character (6) :: a = 'hello ', t
  54   character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
  55   equivalence (s, t)
  56
  57   call option_stopwatch_s (a) ! Call test of PR25619
  58   call p ()                   ! Call test of PR26491
  59   call my_p (line)            ! Call test of PR26550
  60
  61 ! Test Vivek Rao's bug, as reported in PR25619.
  62   s = s(i)
  63   call option_stopwatch_a ((/a,'hola! ', t/))
  64
  65 contains
  66
  67 ! Test PR23634
  68   subroutine option_stopwatch_s(a)
  69     character (*), intent(in) :: a
  70     character (len=len(a)) :: b
  71
  72     b = 'hola! '
  73     call option_stopwatch_a((/a, b, 'goddag'/))
  74   end subroutine option_stopwatch_s
  75   subroutine option_stopwatch_a (a)
  76     character (*) :: a(:)
  77     if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
  78   end subroutine option_stopwatch_a
  79
  80 end program main
  81 ! { dg-final { cleanup-modules "global my_module" } }
  82