From c73140776c32f78f9c7828a5cd8b930680da8b08 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 5 Jan 2009 19:46:06 +0000 Subject: [PATCH] re PR fortran/38657 (PUBLIC/PRIVATE Common blocks) 2009-01-05 Paul Thomas PR fortran/38657 * module.c (write_common_0): Use the name of the symtree rather than the common block, to determine if the common has been written. 2009-01-05 Paul Thomas PR fortran/38657 * gfortran.dg/module_commons_3.f90: New test. From-SVN: r143090 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/module.c | 8 +++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/module_commons_3.f90 | 57 ++++++++++++++++++++++++++ 4 files changed, 75 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/module_commons_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8252bd4..ed66a73 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-01-05 Paul Thomas + + PR fortran/38657 + * module.c (write_common_0): Use the name of the symtree rather + than the common block, to determine if the common has been + written. + 2009-01-05 Daniel Franke PR fortran/37159 diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 1b32ee2..7bbfa12 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4337,6 +4337,7 @@ write_common_0 (gfc_symtree *st) { gfc_common_head *p; const char * name; + const char * lname; int flags; const char *label; struct written_common *w; @@ -4349,6 +4350,9 @@ write_common_0 (gfc_symtree *st) /* We will write out the binding label, or the name if no label given. */ name = st->n.common->name; + + /* Use the symtree(local)name to check if the common has been written. */ + lname = st->name; p = st->n.common; label = p->is_bind_c ? p->binding_label : p->name; @@ -4356,7 +4360,7 @@ write_common_0 (gfc_symtree *st) w = written_commons; while (w) { - int c = strcmp (name, w->name); + int c = strcmp (lname, w->name); c = (c != 0 ? c : strcmp (label, w->label)); if (c == 0) write_me = false; @@ -4384,7 +4388,7 @@ write_common_0 (gfc_symtree *st) /* Record that we have written this common. */ w = XCNEW (struct written_common); - w->name = p->name; + w->name = lname; w->label = label; gfc_insert_bbt (&written_commons, w, compare_written_commons); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fbb3529..b37d770 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-01-05 Paul Thomas + + PR fortran/38657 + * gfortran.dg/module_commons_3.f90: New test. + 2009-01-05 Daniel Franke PR fortran/37159 diff --git a/gcc/testsuite/gfortran.dg/module_commons_3.f90 b/gcc/testsuite/gfortran.dg/module_commons_3.f90 new file mode 100644 index 0000000..9ae6386 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/module_commons_3.f90 @@ -0,0 +1,57 @@ +! { 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 +! 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" } } -- 2.7.4