gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for PR29387, in which array valued arguments of
   3 ! LEN and ASSOCIATED would cause an ICE.
   4 !
   5 ! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
   6 !
   7   integer  :: ans
   8   TYPE T1
   9     INTEGER, POINTER :: I=>NULL()
  10   END TYPE T1
  11   type(T1), pointer :: tar(:)
  12
  13   character(20) res
  14
  15   j = 10
  16   PRINT *, LEN(SUB(8)), ans
  17   PRINT *, LEN(SUB(j)), ans
  18 !  print *, len(SUB(j + 2)//"a"), ans   ! This still fails (no charlen).
  19   print *, len(bar(2)), ans
  20
  21   IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
  22   deallocate (tar)
  23
  24 CONTAINS
  25
  26   FUNCTION SUB(I)
  27     CHARACTER(LEN=I) :: SUB(1)
  28     ans = LEN(SUB(1))
  29     SUB = ""
  30   END FUNCTION
  31
  32   FUNCTION BAR(I)
  33     CHARACTER(LEN=I*10) :: BAR(1)
  34     ans = LEN(BAR)
  35     BAR = ""
  36   END FUNCTION
  37
  38   FUNCTION F1(I) RESULT(R)
  39    TYPE(T1), DIMENSION(:), POINTER :: R
  40    INTEGER :: I
  41    ALLOCATE(tar(I))
  42    R => tar
  43   END FUNCTION F1
  44 END