From dc8c7978e0cab480de3f932d1cb76d7bf5e72816 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 31 Aug 2011 00:09:49 +0200 Subject: re PR fortran/45044 (Different named COMMON block size: No warning) 2011-08-30 Tobias Burnus PR fortran/45044 * trans-common.c (build_common_decl): Warn if named common block's size is not everywhere the same. 2011-08-30 Tobias Burnus PR fortran/45044 * gfortran.dg/common_14.f90: New. * gfortran.dg/common_resize_1.f: Add two dg-warning. From-SVN: r178344 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-common.c | 20 +++++++++++++------- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/common_14.f90 | 27 +++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/common_resize_1.f | 4 ++-- 5 files changed, 54 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/common_14.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4f906b2..397aa77 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-08-30 Tobias Burnus + + PR fortran/45044 + * trans-common.c (build_common_decl): Warn if named common + block's size is not everywhere the same. + 2011-08-30 Steven G. Kargl PR fortran/45170 diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index c289bbe..21237c8 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -390,14 +390,20 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (decl != NULL_TREE) { tree size = TYPE_SIZE_UNIT (union_type); + + /* Named common blocks of the same name shall be of the same size + in all scoping units of a program in which they appear, but + blank common blocks may be of different sizes. */ + if (!tree_int_cst_equal (DECL_SIZE_UNIT (decl), size) + && strcmp (com->name, BLANK_COMMON_NAME)) + gfc_warning ("Named COMMON block '%s' at %L shall be of the " + "same size as elsewhere (%lu vs %lu bytes)", com->name, + &com->where, + (unsigned long) TREE_INT_CST_LOW (size), + (unsigned long) TREE_INT_CST_LOW (DECL_SIZE_UNIT (decl))); + if (tree_int_cst_lt (DECL_SIZE_UNIT (decl), size)) - { - /* Named common blocks of the same name shall be of the same size - in all scoping units of a program in which they appear, but - blank common blocks may be of different sizes. */ - if (strcmp (com->name, BLANK_COMMON_NAME)) - gfc_warning ("Named COMMON block '%s' at %L shall be of the " - "same size", com->name, &com->where); + { DECL_SIZE (decl) = TYPE_SIZE (union_type); DECL_SIZE_UNIT (decl) = size; DECL_MODE (decl) = TYPE_MODE (union_type); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9ae62ab..0c70003 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-08-30 Tobias Burnus + + PR fortran/45044 + * gfortran.dg/common_14.f90: New. + * gfortran.dg/common_resize_1.f: Add two dg-warning. + 2011-08-30 Jason Merrill PR c++/50084 diff --git a/gcc/testsuite/gfortran.dg/common_14.f90 b/gcc/testsuite/gfortran.dg/common_14.f90 new file mode 100644 index 0000000..aced168 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/common_14.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! PR fortran/45044 +! +! Named common blocks need to be all of the same size +! check that the compiler warns for those. + +module m + common /xx/ a +end module m + +subroutine two() +integer :: a, b, c +real(8) :: y +common /xx/ a, b, c, y ! { dg-warning "Named COMMON block 'xx' at \\(1\\) shall be of the same size as elsewhere \\(24 vs 4 bytes" } +end + + +subroutine one() +integer :: a, b +common /xx/ a, b ! { dg-warning "Named COMMON block 'xx' at \\(1\\) shall be of the same size as elsewhere \\(8 vs 24 bytes" } +end + +call two() +end + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/common_resize_1.f b/gcc/testsuite/gfortran.dg/common_resize_1.f index a94c1bc..ecf692d 100644 --- a/gcc/testsuite/gfortran.dg/common_resize_1.f +++ b/gcc/testsuite/gfortran.dg/common_resize_1.f @@ -13,13 +13,13 @@ c c c unpack connection data c - common/aux32/kka(lnv),kkb(lnv),kkc(lnv), + common/aux32/kka(lnv),kkb(lnv),kkc(lnv), ! { dg-warning "shall be of the same size as elsewhere" } 1 kk1(lnv),kk2(lnv),kk3(lnv),dxy(lnv), 2 dyx(lnv),dyz(lnv),dzy(lnv),dzx(lnv), 3 dxz(lnv),vx17(lnv),vx28(lnv),vx35(lnv), 4 vx46(lnv),vy17(lnv),vy28(lnv), 5 vy35(lnv),vy46(lnv),vz17(lnv),vz28(lnv),vz35(lnv),vz46(lnv) - common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv), + common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv), ! { dg-warning "shall be of the same size as elsewhere" } 1 ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv) dimension ixp(nwcon,*) c -- cgit v1.1