Hello,

here is a fix for the regression I introduced with my PR64952 patch.

The regression is a spurious shape mismatch error message coming from a
variable partial initialization through data statements.
Before the patch at the time of the shape check, the initialization is
still unset as processing of data statements comes after that point, so
that no error message is issued.
The PR64952 introduce an extra call to gfc_resolve, which may make
resolve_types be called more than once.  And the second times it is, the
data statements have been processed and error messages are issued.

The patch I propose here adds a flag to remember the function has been
called, and skip it the second time.
I considered reusing the existing 'resolved' field, but I had to
slightly change its semantics to prevent regressing somewhere, and I was
not completely sure how safe that change was.
I have finally preferred this safer patch keeping the existing field
completely untouched.

Regression tested on x86_64-unknown-linux-gnu. OK for trunk?

Mikael

2015-03-24  Mikael Morin  <mik...@gcc.gnu.org>

        PR fortran/64952
        PR fortran/65532
        * gfortran.h (struct gfc_namespace): New field 'types_resolved'.
        * resolve.c (resolve_types): Return early if field 'types_resolved'
        is set.  Set 'types_resolved' at the end.

2015-03-24  Mikael Morin  <mik...@gcc.gnu.org>

        PR fortran/64952
        PR fortran/65532
        * gfortran.dg/data_initialized_3.f90: New.
Index: gfortran.h
===================================================================
--- gfortran.h	(révision 221586)
+++ gfortran.h	(copie de travail)
@@ -1691,6 +1691,9 @@ typedef struct gfc_namespace
      Holds -1 during resolution.  */
   signed resolved:2;
 
+  /* Set when resolve_types has been called for this namespace.  */
+  unsigned types_resolved:1;
+
   /* Set to 1 if code has been generated for this namespace.  */
   unsigned translated:1;
 
Index: resolve.c
===================================================================
--- resolve.c	(révision 221586)
+++ resolve.c	(copie de travail)
@@ -14942,6 +14942,9 @@ resolve_types (gfc_namespace *ns)
   gfc_equiv *eq;
   gfc_namespace* old_ns = gfc_current_ns;
 
+  if (ns->types_resolved)
+    return;
+
   /* Check that all IMPLICIT types are ok.  */
   if (!ns->seen_implicit_none)
     {
@@ -15016,6 +15019,8 @@ resolve_types (gfc_namespace *ns)
 
   gfc_resolve_omp_udrs (ns->omp_udr_root);
 
+  ns->types_resolved = 1;
+
   gfc_current_ns = old_ns;
 }
 

! { dg-do compile }
!
! PR fortran/65532
! The partial initialization through data statements was producing
! shape mismatch errors.
!
! Contributed by Harald Anlauf  <anl...@gmx.de>

module gfcbug131
  implicit none
contains
  DOUBLE PRECISION FUNCTION d1mach(i)
    INTEGER, INTENT(IN)         :: i

    INTEGER :: small(4)
    INTEGER :: large(4)
    INTEGER :: right(4)
    INTEGER :: diver(4)
    INTEGER :: LOG10(4)
    DOUBLE PRECISION :: dmach(5)

    EQUIVALENCE (dmach(1),small(1))
    EQUIVALENCE (dmach(2),large(1))
    EQUIVALENCE (dmach(3),right(1))
    EQUIVALENCE (dmach(4),diver(1))
    EQUIVALENCE (dmach(5),LOG10(1))

    DATA small(1),small(2) /          0,    1048576 /
    DATA large(1),large(2) /         -1, 2146435071 /
    DATA right(1),right(2) /          0, 1017118720 /
    DATA diver(1),diver(2) /          0, 1018167296 /
    DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 /

    d1mach = dmach(i)
  END FUNCTION d1mach

  DOUBLE PRECISION FUNCTION foo (x)
    DOUBLE PRECISION, INTENT(IN) :: x
    foo = SQRT (d1mach(4))
  END FUNCTION foo

end module gfcbug131


Reply via email to