re PR fortran/45044 (Different named COMMON block size: No warning)
authorTobias Burnus <burnus@net-b.de>
Tue, 30 Aug 2011 22:09:49 +0000 (00:09 +0200)
committerTobias Burnus <burnus@gcc.gnu.org>
Tue, 30 Aug 2011 22:09:49 +0000 (00:09 +0200)
2011-08-30  Tobias Burnus  <burnus@net-b.de>

        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  <burnus@net-b.de>

        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
gcc/fortran/trans-common.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/common_14.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/common_resize_1.f

index 4f906b26666bc1cfadb93c4b1a651a29c70ae1db..397aa7710402a266f5885f61655a87057ce6077f 100644 (file)
@@ -1,3 +1,9 @@
+2011-08-30  Tobias Burnus  <burnus@net-b.de>
+
+       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  <kargl@gcc.gnu.org>
 
        PR fortran/45170
index c289bbe3dafdb7ef0cfd36ef2e7f3317b184c636..21237c8d8eca0fbd86b64ea51845ee54bcd09c77 100644 (file)
@@ -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);
index 9ae62abd7ed2d2be5962855bb1fbb7ec19bc1547..0c70003705d4250502e9fed2de019c32291231f7 100644 (file)
@@ -1,3 +1,9 @@
+2011-08-30  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45044
+       * gfortran.dg/common_14.f90: New.
+       * gfortran.dg/common_resize_1.f: Add two dg-warning.
+
 2011-08-30  Jason Merrill  <jason@redhat.com>
 
        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 (file)
index 0000000..aced168
--- /dev/null
@@ -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" } }
index a94c1bc0c6a74e330918f2913f172584f5523bc8..ecf692d2d48103a13d6964821b97b2e6161b89c5 100644 (file)
@@ -13,13 +13,13 @@ c
 c\r
 c     unpack connection data\r
 c\r
-      common/aux32/kka(lnv),kkb(lnv),kkc(lnv),\r
+      common/aux32/kka(lnv),kkb(lnv),kkc(lnv), ! { dg-warning "shall be of the same size as elsewhere" }\r
      1 kk1(lnv),kk2(lnv),kk3(lnv),dxy(lnv),\r
      2 dyx(lnv),dyz(lnv),dzy(lnv),dzx(lnv),\r
      3 dxz(lnv),vx17(lnv),vx28(lnv),vx35(lnv),\r
      4 vx46(lnv),vy17(lnv),vy28(lnv),\r
      5 vy35(lnv),vy46(lnv),vz17(lnv),vz28(lnv),vz35(lnv),vz46(lnv)\r
-      common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),\r
+      common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv), ! { dg-warning "shall be of the same size as elsewhere" }\r
      1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv)\r
       dimension ixp(nwcon,*)\r
 c\r