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 9module global 10 public p, line 11 interface p 12 module procedure p 13 end interface 14 character(128) :: line = 'abcdefghijklmnopqrstuvwxyz' 15contains 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) STOP 1 24 end subroutine redirect_ 25end module global 26 27! Test PR26550 28module my_module 29 implicit none 30 type point 31 real :: x 32 end type point 33 type(point), pointer, public :: stdin => NULL() 34contains 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)) STOP 2 44 if (io(1) .ne. line) STOP 3 45 end subroutine r 46end module my_module 47 48program 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 65contains 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'/))) STOP 4 78 end subroutine option_stopwatch_a 79 80end program main 81