[Bug fortran/83088] New: ICE with -init-derived

[valeryweber at hotmail dot com]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83088

            Bug ID: 83088
           Summary: ICE with -init-derived
           Product: gcc
           Version: 8.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: valeryweber at hotmail dot com
  Target Milestone: ---

hi all
the following code is ICEing
v

gfortran-intel-trunk -free -c -finit-derived  hfx_libint_wrapper.F90           
                 hfx_libint_wrapper.F90:101:0:

 END MODULE hfx_libint_wrapper

internal compiler error: Segmentation fault
0xc2f705 crash_signal
        ../../gcc-trunk-src/gcc/toplev.c:325
0x6ba206 contains_struct_check
        ../../gcc-trunk-src/gcc/tree.h:3203
0x6ba206 gfc_conv_structure(gfc_se*, gfc_expr*, int)
        ../../gcc-trunk-src/gcc/fortran/trans-expr.c:7751
0x674480 gfc_conv_array_initializer(tree_node*, gfc_expr*)
        ../../gcc-trunk-src/gcc/fortran/trans-array.c:5894
0x6b9dfa gfc_conv_initializer(gfc_expr*, gfc_typespec*, tree_node*, bool, bool,
bool)
        ../../gcc-trunk-src/gcc/fortran/trans-expr.c:6848
0x69c48f gfc_get_symbol_decl(gfc_symbol*)
        ../../gcc-trunk-src/gcc/fortran/trans-decl.c:1825
0x69e063 gfc_create_module_variable
        ../../gcc-trunk-src/gcc/fortran/trans-decl.c:4943
0x653930 do_traverse_symtree
        ../../gcc-trunk-src/gcc/fortran/symbol.c:4157
0x69d4d2 gfc_generate_module_vars(gfc_namespace*)
        ../../gcc-trunk-src/gcc/fortran/trans-decl.c:5415
0x66b2c8 gfc_generate_module_code(gfc_namespace*)
        ../../gcc-trunk-src/gcc/fortran/trans.c:2180
0x6212c2 translate_all_program_units
        ../../gcc-trunk-src/gcc/fortran/parse.c:6078
0x6212c2 gfc_parse_file()
        ../../gcc-trunk-src/gcc/fortran/parse.c:6294
0x66775f gfc_be_parse_file
        ../../gcc-trunk-src/gcc/fortran/f95-lang.c:204
Please submit a full bug report,
with preprocessed source if appropriate.
Please include the complete backtrace with any bug report.
See <https://gcc.gnu.org/bugs/> for instructions.





cat hfx_libint_wrapper.F90
MODULE hfx_libint_wrapper
   USE ISO_C_BINDING,                   ONLY: C_DOUBLE,&
                                              C_F_POINTER,&
                                              C_F_PROCPOINTER,&
                                              C_INT,&
                                              C_LOC,&
                                              C_PTR,&
                                              c_funptr

   IMPLICIT NONE
   PRIVATE

   INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(14, 200)

   integer,parameter :: build_deriv1_eri_size=10,build_eri_size=2,
libderiv_max_am1=4, &
        libint_max_am=4, libint_dvrr_classes_size=1, libint_vrr_classes_size=1,
prim_data_f_size=1
   integer, dimension(1):: nco

   TYPE, BIND(C) :: prim_data
      REAL(C_DOUBLE) :: F(prim_data_f_size)
      REAL(C_DOUBLE) :: U(3, 6)
      REAL(C_DOUBLE) :: twozeta_a
      REAL(C_DOUBLE) :: twozeta_b
      REAL(C_DOUBLE) :: twozeta_c
      REAL(C_DOUBLE) :: twozeta_d
      REAL(C_DOUBLE) :: oo2z
      REAL(C_DOUBLE) :: oo2n
      REAL(C_DOUBLE) :: oo2zn
      REAL(C_DOUBLE) :: poz
      REAL(C_DOUBLE) :: pon
      REAL(C_DOUBLE) :: oo2p
      REAL(C_DOUBLE) :: ss_r12_ss
   END TYPE prim_data


   TYPE, BIND(C) :: lib_int
      TYPE(C_PTR)     :: int_stack
      TYPE(C_PTR)     :: PrimQuartet
      REAL(C_DOUBLE)  :: AB(3)
      REAL(C_DOUBLE)  :: CD(3)
      TYPE(C_PTR)     :: vrr_classes(libint_vrr_classes_size,
libint_vrr_classes_size)
      TYPE(C_PTR)     :: vrr_stack
   END TYPE lib_int

   TYPE, BIND(C) :: lib_deriv
      TYPE(C_PTR)     :: int_stack
      TYPE(C_PTR)     :: PrimQuartet
      TYPE(C_PTR)     :: zero_stack
      TYPE(C_PTR)     :: ABCD(156)
      REAL(C_DOUBLE)  :: AB(3)
      REAL(C_DOUBLE)  :: CD(3)
      TYPE(C_PTR)     :: deriv_classes(12, libint_dvrr_classes_size,
libint_dvrr_classes_size)
      TYPE(C_PTR)     :: deriv2_classes(144, libint_dvrr_classes_size,
libint_dvrr_classes_size)
      TYPE(C_PTR)     :: dvrr_classes(libint_dvrr_classes_size,
libint_dvrr_classes_size)
      TYPE(C_PTR)     :: dvtt_stack
   END TYPE lib_deriv

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_libint_wrapper'


   TYPE(C_FUNPTR), DIMENSION(0:build_eri_size, 0:build_eri_size,
0:build_eri_size, 0:build_eri_size), BIND(C) :: build_eri
   TYPE(C_FUNPTR), DIMENSION(0:build_deriv1_eri_size, 0:build_deriv1_eri_size,
&
                             0:build_deriv1_eri_size, 0:build_deriv1_eri_size),
BIND(C) :: build_deriv1_eri

   INTERFACE
      SUBROUTINE build_deriv1(deriv, np) BIND(C)
         IMPORT
         TYPE(lib_deriv)                :: deriv
         INTEGER(KIND=C_INT), VALUE      :: np
      END SUBROUTINE build_deriv1
   END INTERFACE

CONTAINS
   SUBROUTINE get_derivs(n_d, n_c, n_b, n_a, deriv, prim, work_forces,
a_mysize)
      INTEGER, INTENT(IN)                                :: n_d, n_c, n_b, n_a
      TYPE(lib_deriv)                                    :: deriv
      TYPE(prim_data), TARGET                            :: prim
      REAL(dp), DIMENSION(nco(n_a)*nco(n_b)*nco(n_c)*nco&
         (n_d), 12)                                      :: work_forces
      INTEGER                                            :: a_mysize(1)

      PROCEDURE(build_deriv1), POINTER         :: pbuild_deriv1
      TYPE(C_PTR)                              :: pc_result
      REAL(C_DOUBLE), DIMENSION(:), POINTER    :: tmp_data
      INTEGER                                  :: i, k

      deriv%PrimQuartet = C_LOC(prim)
      CALL C_F_PROCPOINTER(build_deriv1_eri(n_d, n_c, n_b, n_a), pbuild_deriv1)
      CALL pbuild_deriv1(deriv, 1)

      DO k = 1, 12
         IF (k == 4 .OR. k == 5 .OR. k == 6) CYCLE
         pc_result = deriv%ABCD(k)
         CALL C_F_POINTER(pc_result, tmp_data, a_mysize)
         DO i = 1, a_mysize(1)
            work_forces(i, k) = tmp_data(i)
         ENDDO
      END DO
   END SUBROUTINE get_derivs

END MODULE hfx_libint_wrapper