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   TYPE T1
   8     INTEGER, POINTER :: I=>NULL()
   9   END TYPE T1
  10   character(20) res
  11
  12   j = 10
  13   PRINT *, LEN(SUB(8))
  14   PRINT *, LEN(SUB(j))
  15 ! print *, len(SUB(j + 2)//"a")   ! This still fails (no charlen).
  16   print *, len(bar(2))
  17
  18   IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
  19
  20 CONTAINS
  21
  22   FUNCTION SUB(I)
  23     CHARACTER(LEN=I) :: SUB(1)
  24     PRINT *, LEN(SUB(1))
  25   END FUNCTION
  26
  27   FUNCTION BAR(I)
  28     CHARACTER(LEN=I*10) :: BAR(1)
  29     PRINT *, LEN(BAR)
  30   END FUNCTION
  31
  32   FUNCTION F1(I) RESULT(R)
  33    TYPE(T1), DIMENSION(:), POINTER :: R
  34    INTEGER :: I
  35    ALLOCATE(R(I))
  36   END FUNCTION F1
  37 END