gcc/testsuite/gfortran.dg/generic_15.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR34231, in which the assumed size 'cnames'
   3 ! would be wrongly associated with the scalar argument.
   4 !
   5 ! Contributed by <francois.jacq@irsn.fr>
   6 !
   7 MODULE test
   8
   9    TYPE odbase ; INTEGER :: value ; END TYPE
  10
  11    INTERFACE odfname
  12       MODULE PROCEDURE odfamilycname,odfamilycnames
  13    END INTERFACE
  14
  15    CONTAINS
  16
  17    SUBROUTINE odfamilycnames(base,nfam,cnames)
  18       TYPE(odbase),INTENT(in)  :: base
  19       INTEGER     ,INTENT(out) :: nfam
  20       CHARACTER(*),INTENT(out) :: cnames(*)
  21       cnames(1:nfam)='odfamilycnames'
  22    END SUBROUTINE
  23
  24    SUBROUTINE odfamilycname(base,pos,cname)
  25       TYPE(odbase),INTENT(in)  :: base
  26       INTEGER     ,INTENT(in)  :: pos
  27       CHARACTER(*),INTENT(out) :: cname
  28       cname='odfamilycname'
  29    END SUBROUTINE
  30
  31 END MODULE
  32
  33 PROGRAM main
  34   USE test
  35   TYPE(odbase) :: base
  36   INTEGER :: i=1
  37   CHARACTER(14) :: cname
  38   CHARACTER(14) :: cnames(1)
  39   CALL odfname(base,i,cname)
  40   if (trim (cname) .ne. "odfamilycname") call abort
  41   CALL odfname(base,i,cnames)
  42   if (trim (cnames(1)) .ne. "odfamilycnames") call abort
  43 END PROGRAM