2007-06-14 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/32302
	* trans-common.c (build_common_decl): If resizing of common
	decl is needed, update the TREE_TYPE.

2007-06-14  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32302
	* gfortran.dg/common_resize_1.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125708 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 43fcc43..c2c8dd4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-06-14  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/32302
+       * trans-common.c (build_common_decl): If resizing of common
+       decl is needed, update the TREE_TYPE.
+
 2007-06-13  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/32323

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index afcbb1c..78cb7be 100644 (file)
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -360,14 +360,15 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
       tree size = TYPE_SIZE_UNIT (union_type);
       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))
+         /* 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_UNIT (decl) = size;
-        }
+         DECL_SIZE_UNIT (decl) = size;
+         TREE_TYPE (decl) = union_type;
+       }
      }
 
   /* If this common block has been declared in a previous program unit,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2f845e9..930493b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-14  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/32302
+       * gfortran.dg/common_resize_1.f90: New test.
+
 2007-06-14  Dorit Nuzman  <dorit@il.ibm.com>
 
        PR target/32274

diff --git a/gcc/testsuite/gfortran.dg/common_resize_1.f b/gcc/testsuite/gfortran.dg/common_resize_1.f
new file mode 100644 (file)
index 0000000..7d4baaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_resize_1.f
@@ -0,0 +1,176 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+c Tests the fix for PR32302, in which the resizing of 'aux32' would cause
+c misalignment for double precision types and a wrong result would be obtained\r
+c at any level of optimization except none.
+c
+c Contributed by Dale Ranta <dir@lanl.gov> 
+c
+      subroutine unpki(ixp,nwcon,nmel)\r
+      parameter(lnv=32)\r
+      implicit double precision (a-h,o-z)                                    dp\r
+c\r
+c     unpack connection data\r
+c\r
+      common/aux32/kka(lnv),kkb(lnv),kkc(lnv),\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
+     1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv)\r
+      dimension ixp(nwcon,*)\r
+c\r
+      return\r
+      end\r
+      subroutine prtal\r
+      parameter(lnv=32)\r
+      implicit double precision (a-h,o-z)                                    dp\r
+      common/aux8/\r
+     & x1(lnv),x2(lnv),x3(lnv),x4(lnv),\r
+     & x5(lnv),x6(lnv),x7(lnv),x8(lnv),\r
+     & y1(lnv),y2(lnv),y3(lnv),y4(lnv),\r
+     & y5(lnv),y6(lnv),y7(lnv),y8(lnv),\r
+     & z1(lnv),z2(lnv),z3(lnv),z4(lnv),\r
+     & z5(lnv),z6(lnv),z7(lnv),z8(lnv)\r
+      common/aux9/vlrho(lnv),det(lnv)\r
+      common/aux10/\r
+     1 px1(lnv),px2(lnv),px3(lnv),px4(lnv),\r
+     & px5(lnv),px6(lnv),px7(lnv),px8(lnv),\r
+     2 py1(lnv),py2(lnv),py3(lnv),py4(lnv),\r
+     & py5(lnv),py6(lnv),py7(lnv),py8(lnv),\r
+     3 pz1(lnv),pz2(lnv),pz3(lnv),pz4(lnv),\r
+     & pz5(lnv),pz6(lnv),pz7(lnv),pz8(lnv),\r
+     4 vx1(lnv),vx2(lnv),vx3(lnv),vx4(lnv),\r
+     5 vx5(lnv),vx6(lnv),vx7(lnv),vx8(lnv),\r
+     6 vy1(lnv),vy2(lnv),vy3(lnv),vy4(lnv),\r
+     7 vy5(lnv),vy6(lnv),vy7(lnv),vy8(lnv),\r
+     8 vz1(lnv),vz2(lnv),vz3(lnv),vz4(lnv),\r
+     9 vz5(lnv),vz6(lnv),vz7(lnv),vz8(lnv)\r
+      common/aux32/    ! { dg-warning "shall be of the same size" }\r
+     a a17(lnv),a28(lnv),dett(lnv),\r
+     1 aj1(lnv),aj2(lnv),aj3(lnv),aj4(lnv),\r
+     2 aj5(lnv),aj6(lnv),aj7(lnv),aj8(lnv),\r
+     3 aj9(lnv),x17(lnv),x28(lnv),x35(lnv),\r
+     4 x46(lnv),y17(lnv),y28(lnv),y35(lnv),\r
+     5 y46(lnv),z17(lnv),z28(lnv),z35(lnv),z46(lnv)\r
+      common/aux33/    ! { dg-warning "shall be of the same size" }\r
+     a ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),\r
+     1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv),nmel\r
+      common/aux36/lft,llt\r
+      common/failu/sieu(lnv),failu(lnv)\r
+      common/sand1/ihf,ibemf,ishlf,itshf\r
+      dimension aj5968(lnv),aj6749(lnv),aj4857(lnv),aji1(lnv),aji2(lnv),\r
+     1          aji3(lnv),aji4(lnv),aji5(lnv),\r
+     1          aji6(lnv),aji7(lnv),aji8(lnv),aji9(lnv),aj12(lnv),\r
+     2          aj45(lnv),aj78(lnv),b17(lnv),b28(lnv),c17(lnv),c28(lnv)\r
+c\r
+      equivalence (x17,aj5968),(x28,aj6749),(x35,aj4857),(x46,aji1),\r
+     1 (y17,aji2),(y28,aji3),(y35,aji4),(y46,aji5),(z17,aji6),\r
+     2 (z28,aji7),(z35,aji8),(z46,aji9),(aj1,aj12),(aj2,aj45),\r
+     3 (aj3,aj78),(px1,b17),(px2,b28),(px3,c17),(px4,c28)\r
+      data o64th/0.0156250/\r
+c\r
+c     jacobian matrix\r
+c\r
+      do 10 i=lft,llt\r
+      x17(i)=x7(i)-x1(i)\r
+      x28(i)=x8(i)-x2(i)\r
+      x35(i)=x5(i)-x3(i)\r
+      x46(i)=x6(i)-x4(i)\r
+      y17(i)=y7(i)-y1(i)\r
+      y28(i)=y8(i)-y2(i)\r
+      y35(i)=y5(i)-y3(i)\r
+      y46(i)=y6(i)-y4(i)\r
+      z17(i)=z7(i)-z1(i)\r
+      z28(i)=z8(i)-z2(i)\r
+      z35(i)=z5(i)-z3(i)\r
+   10 z46(i)=z6(i)-z4(i)\r
+      do 20 i=lft,llt\r
+      aj1(i)=x17(i)+x28(i)-x35(i)-x46(i)\r
+      aj2(i)=y17(i)+y28(i)-y35(i)-y46(i)\r
+      aj3(i)=z17(i)+z28(i)-z35(i)-z46(i)\r
+      a17(i)=x17(i)+x46(i)\r
+      a28(i)=x28(i)+x35(i)\r
+      b17(i)=y17(i)+y46(i)\r
+      b28(i)=y28(i)+y35(i)\r
+      c17(i)=z17(i)+z46(i)\r
+   20 c28(i)=z28(i)+z35(i)\r
+      do 30 i=lft,llt\r
+      aj4(i)=a17(i)+a28(i)\r
+      aj5(i)=b17(i)+b28(i)\r
+      aj6(i)=c17(i)+c28(i)\r
+      aj7(i)=a17(i)-a28(i)\r
+      aj8(i)=b17(i)-b28(i)\r
+   30 aj9(i)=c17(i)-c28(i)\r
+c\r
+c     jacobian\r
+c\r
+      do 40 i=lft,llt\r
+      aj5968(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)\r
+      aj6749(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)\r
+   40 aj4857(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)\r
+      if (ihf.ne.1) then\r
+      do 50 i=lft,llt\r
+   50 det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))\r
+      else\r
+      do 55 i=lft,llt\r
+      det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))\r
+     1       *failu(i) + (1. - failu(i))\r
+   55 continue\r
+      endif\r
+      do 60 i=lft,llt\r
+   60 dett(i)=o64th/det(i)\r
+\r
+      if (det(lft) .ne. 1d0) call abort ()
+      if (det(llt) .ne. 1d0) call abort ()\r
+\r
+      return\r
+c\r
+      end\r
+      program main\r
+      parameter(lnv=32)\r
+      implicit double precision (a-h,o-z)                                    dp\r
+      common/aux8/\r
+     & x1(lnv),x2(lnv),x3(lnv),x4(lnv),\r
+     & x5(lnv),x6(lnv),x7(lnv),x8(lnv),\r
+     & y1(lnv),y2(lnv),y3(lnv),y4(lnv),\r
+     & y5(lnv),y6(lnv),y7(lnv),y8(lnv),\r
+     & z1(lnv),z2(lnv),z3(lnv),z4(lnv),\r
+     & z5(lnv),z6(lnv),z7(lnv),z8(lnv)\r
+      common/aux36/lft,llt\r
+      common/sand1/ihf,ibemf,ishlf,itshf\r
+      lft=1\r
+      llt=1\r
+      x1(1)=0\r
+      x2(1)=1\r
+      x3(1)=1\r
+      x4(1)=0\r
+      x5(1)=0\r
+      x6(1)=1\r
+      x7(1)=1\r
+      x8(1)=0\r
+\r
+      y1(1)=0\r
+      y2(1)=0\r
+      y3(1)=1\r
+      y4(1)=1\r
+      y5(1)=0\r
+      y6(1)=0\r
+      y7(1)=1\r
+      y8(1)=1\r
+\r
+      z1(1)=0\r
+      z2(1)=0\r
+      z3(1)=0\r
+      z4(1)=0\r
+      z5(1)=1\r
+      z6(1)=1\r
+      z7(1)=1\r
+      z8(1)=1\r
+      call prtal\r
+      stop\r
+      end\r
+\r