OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/38657 (PUBLIC/PRIVATE Common blocks)

Browse Source 
2009-01-05  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/38657
	* gfortran.dg/module_commons_3.f90: New test.

From-SVN: r143090
This commit is contained in:
Paul Thomas 2009-01-05 19:46:06 +00:00
parent b55c4f04b3
commit c73140776c
4 changed files with 75 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2009-01-05 Paul Thomas <pault@gcc.gnu.org>
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 <franke.daniel@gmail.com>
PR fortran/37159

8
gcc/fortran/module.c
View File

@ -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);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-01-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38657
* gfortran.dg/module_commons_3.f90: New test.
2009-01-05 Daniel Franke <franke.daniel@gmail.com>
PR fortran/37159

57
gcc/testsuite/gfortran.dg/module_commons_3.f90 Normal file
View File

@ -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 <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" } }