gcc/testsuite/gfortran.dg/module_commons_3.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/38657, in which the mixture of PRIVATE and
   4 ! COMMON in TEST4, would mess up the association with
   5 ! TESTCHAR in TEST2.
   6 !
   7 ! Contributed by Paul Thomas <pault@gcc.gnu.org>
   8 ! From a report in clf by Chris Bradley.
   9 !
  10 MODULE TEST4
  11   PRIVATE
  12   CHARACTER(LEN=80) :: T1 = &
  13     "Mary had a little lamb, Its fleece was white as snow;"
  14   CHARACTER(LEN=80) :: T2 = &
  15     "And everywhere that Mary went, The lamb was sure to go."
  16   CHARACTER(LEN=80) :: TESTCHAR
  17   COMMON /TESTCOMMON1/ TESTCHAR
  18   PUBLIC T1, T2, FOOBAR
  19 CONTAINS
  20   subroutine FOOBAR (CHECK)
  21     CHARACTER(LEN=80) :: CHECK
  22     IF (TESTCHAR .NE. CHECK) CALL ABORT
  23   end subroutine
  24 END MODULE TEST4
  25
  26 MODULE TEST3
  27   CHARACTER(LEN=80) :: TESTCHAR
  28   COMMON /TESTCOMMON1/ TESTCHAR
  29 END MODULE TEST3
  30
  31 MODULE TEST2
  32   use TEST4
  33   USE TEST3, chr => testchar
  34   PRIVATE
  35   CHARACTER(LEN=80) :: TESTCHAR
  36   COMMON /TESTCOMMON1/ TESTCHAR
  37   PUBLIC TESTCHAR, FOO, BAR, CHR, T1, T2, FOOBAR
  38 contains
  39   subroutine FOO
  40     TESTCHAR = T1
  41   end subroutine
  42   subroutine BAR (CHECK)
  43     CHARACTER(LEN=80) :: CHECK
  44     IF (TESTCHAR .NE. CHECK) CALL ABORT
  45     IF (CHR .NE. CHECK) CALL ABORT
  46   end subroutine
  47 END MODULE TEST2
  48
  49 PROGRAM TEST1
  50   USE TEST2
  51   call FOO
  52   call BAR (T1)
  53   TESTCHAR = T2
  54   call BAR (T2)
  55   CALL FOOBAR (T2)
  56 END PROGRAM TEST1