1! { dg-do run } 2! 3! Tests the fix for PR68216 4! 5! Reported on clf: https://groups.google.com/forum/#!topic/comp.lang.fortran/eWQTKfqKLZc 6! 7PROGRAM hello 8! 9! This is based on the first testcase, from Francisco (Ayyy LMAO). Original 10! lines are commented out. The second testcase from this thread is acalled 11! at the end of the program. 12! 13 IMPLICIT NONE 14 15 CHARACTER(LEN=:),DIMENSION(:),ALLOCATABLE :: array_lineas 16 CHARACTER(LEN=:),DIMENSION(:),ALLOCATABLE :: array_copia 17 character (3), dimension (2) :: array_fijo = ["abc","def"] 18 character (100) :: buffer 19 INTEGER :: largo , cant_lineas , i 20 21 write (buffer, "(2a3)") array_fijo 22 23! WRITE(*,*) ' Escriba un numero para el largo de cada linea' 24! READ(*,*) largo 25 largo = LEN (array_fijo) 26 27! WRITE(*,*) ' Escriba la cantidad de lineas' 28! READ(*,*) cant_lineas 29 cant_lineas = size (array_fijo, 1) 30 31 ALLOCATE(CHARACTER(LEN=largo) :: array_lineas(cant_lineas)) 32 33! WRITE(*,*) 'Escriba el array', len(array_lineas), size(array_lineas) 34 READ(buffer,"(2a3)") (array_lineas(i),i=1,cant_lineas) 35 36! WRITE(*,*) 'Array guardado: ' 37! DO i=1,cant_lineas 38! WRITE(*,*) array_lineas(i) 39! ENDDO 40 if (any (array_lineas .ne. array_fijo)) STOP 1 41 42! The following are additional tests beyond that of the original. 43! 44! Check that allocation with source = another deferred length is OK 45 allocate (array_copia, source = array_lineas) 46 if (any (array_copia .ne. array_fijo)) STOP 2 47 deallocate (array_lineas, array_copia) 48 49! Check that allocation with source = a non-deferred length is OK 50 allocate (array_lineas, source = array_fijo) 51 if (any (array_lineas .ne. array_fijo)) STOP 3 52 deallocate (array_lineas) 53 54! Check that allocation with MOLD = a non-deferred length is OK 55 allocate (array_copia, mold = [array_fijo(:)(1:2), array_fijo(:)(1:2)]) 56 if (size (array_copia, 1) .ne. 4) STOP 4 57 if (LEN (array_copia, 1) .ne. 2) STOP 5 58 59! Check that allocation with MOLD = another deferred length is OK 60 allocate (array_lineas, mold = array_copia) 61 if (size (array_copia, 1) .ne. 4) STOP 6 62 if (LEN (array_copia, 1) .ne. 2) STOP 7 63 deallocate (array_lineas, array_copia) 64 65! READ(*,*) 66 call testdefchar 67contains 68 subroutine testdefchar 69! 70! This is the testcase in the above thread from Blokbuster 71! 72 implicit none 73 character(:), allocatable :: test(:) 74 75 allocate(character(3) :: test(2)) 76 test(1) = 'abc' 77 test(2) = 'def' 78 if (any (test .ne. ['abc', 'def'])) STOP 8 79 80 test = ['aa','bb','cc'] 81 if (any (test .ne. ['aa', 'bb', 'cc'])) STOP 9 82 83 end subroutine testdefchar 84 85END PROGRAM 86