PR fortran/38657
* module.c (write_common_0): Add argument 'this_module' and
check that non-use associated common blocks are written first.
(write_common): Call write_common_0 twice, once with true and
then with false.
2009-01-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38657
* gfortran.dg/module_commons_3.f90: Reapply.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@143463
138bc75d-0d04-0410-961f-
82ee72b054a4
2009-01-17 Paul Thomas <pault@gcc.gnu.org>
+ PR fortran/38657
+ * module.c (write_common_0): Add argument 'this_module' and
+ check that non-use associated common blocks are written first.
+ (write_common): Call write_common_0 twice, once with true and
+ then with false.
+
+2009-01-17 Paul Thomas <pault@gcc.gnu.org>
+
PR fortran/34955
* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Has
been absorbed into gfc_conv_intrinsic_transfer. All
/* Write a common block to the module -- recursive helper function. */
static void
-write_common_0 (gfc_symtree *st)
+write_common_0 (gfc_symtree *st, bool this_module)
{
gfc_common_head *p;
const char * name;
if (st == NULL)
return;
- write_common_0 (st->left);
+ write_common_0 (st->left, this_module);
/* We will write out the binding label, or the name if no label given. */
name = st->n.common->name;
w = (c < 0) ? w->left : w->right;
}
+ if (this_module && p->use_assoc)
+ write_me = false;
+
if (write_me)
{
/* Write the common to the module. */
gfc_insert_bbt (&written_commons, w, compare_written_commons);
}
- write_common_0 (st->right);
+ write_common_0 (st->right, this_module);
}
write_common (gfc_symtree *st)
{
written_commons = NULL;
- write_common_0 (st);
+ write_common_0 (st, true);
+ write_common_0 (st, false);
free_written_common (written_commons);
written_commons = NULL;
}
2009-01-17 Paul Thomas <pault@gcc.gnu.org>
+ PR fortran/38657
+ * gfortran.dg/module_commons_3.f90: Reapply.
+
+2009-01-17 Paul Thomas <pault@gcc.gnu.org>
+
PR fortran/34955
* gfortran.dg/transfer_intrinsic_1.f90: New test.
* gfortran.dg/transfer_intrinsic_2.f90: New test.
--- /dev/null
+! { dg-do run }
+!
+! PR fortran/38657, in which the mixture of PRIVATE and
+! COMMON in TEST4, would mess up the association with
+! TESTCHAR in TEST2.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+! From a report in clf by Chris Bradley.
+!
+MODULE TEST4
+ PRIVATE
+ CHARACTER(LEN=80) :: T1 = &
+ "Mary had a little lamb, Its fleece was white as snow;"
+ CHARACTER(LEN=80) :: T2 = &
+ "And everywhere that Mary went, The lamb was sure to go."
+ CHARACTER(LEN=80) :: TESTCHAR
+ COMMON /TESTCOMMON1/ TESTCHAR
+ PUBLIC T1, T2, FOOBAR
+CONTAINS
+ subroutine FOOBAR (CHECK)
+ CHARACTER(LEN=80) :: CHECK
+ IF (TESTCHAR .NE. CHECK) CALL ABORT
+ end subroutine
+END MODULE TEST4
+
+MODULE TEST3
+ CHARACTER(LEN=80) :: TESTCHAR
+ COMMON /TESTCOMMON1/ TESTCHAR
+END MODULE TEST3
+
+MODULE TEST2
+ use TEST4
+ USE TEST3, chr => testchar
+ PRIVATE
+ CHARACTER(LEN=80) :: TESTCHAR
+ COMMON /TESTCOMMON1/ TESTCHAR
+ PUBLIC TESTCHAR, FOO, BAR, CHR, T1, T2, FOOBAR
+contains
+ subroutine FOO
+ TESTCHAR = T1
+ end subroutine
+ subroutine BAR (CHECK)
+ CHARACTER(LEN=80) :: CHECK
+ IF (TESTCHAR .NE. CHECK) CALL ABORT
+ IF (CHR .NE. CHECK) CALL ABORT
+ end subroutine
+END MODULE TEST2
+
+PROGRAM TEST1
+ USE TEST2
+ call FOO
+ call BAR (T1)
+ TESTCHAR = T2
+ call BAR (T2)
+ CALL FOOBAR (T2)
+END PROGRAM TEST1
+! { dg-final { cleanup-modules "TEST2 TEST3 TEST4" } }