code.ossystems Code Review - openembedded-core.git/blob

   1 From ead753a2ac74bd306d240de4760b7f809c581052 Mon Sep 17 00:00:00 2001
   2 From: burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
   3 Date: Tue, 26 Apr 2011 08:41:31 +0000
   4 Subject: [PATCH 180/200] 2011-04-26  Tobias Burnus  <burnus@net-b.de>
   5
   6         PR fortran/48588
   7         * parse.c (resolve_all_program_units): Skip modules.
   8         (translate_all_program_units): Handle modules.
   9         (gfc_parse_file): Defer code generation for modules.
  10         * module.c (fix_mio_expr): Commit created symbol.
  11
  12 2011-04-26  Tobias Burnus  <burnus@net-b.de>
  13
  14         PR fortran/48588
  15         * gfortran.dg/whole_file_33.f90: New.
  16
  17
  18
  19 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@172953 138bc75d-0d04-0410-961f-82ee72b054a4
  20
  21 index 923f8c6..94b4459 100644
  22 --- a/gcc/fortran/module.c
  23 +++ b/gcc/fortran/module.c
  24 @@ -3011,6 +3011,7 @@ fix_mio_expr (gfc_expr *e)
  25        sym->attr.flavor = FL_PROCEDURE;
  26        sym->attr.generic = 1;
  27        e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
  28 +      gfc_commit_symbol (sym);
  29      }
  30  }
  31
  32 diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
  33 index 7fc3dca..7b24cc4 100644
  34 --- a/gcc/fortran/parse.c
  35 +++ b/gcc/fortran/parse.c
  36 @@ -4191,6 +4191,10 @@ resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
  37    gfc_current_ns = gfc_global_ns_list;
  38    for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
  39      {
  40 +      if (gfc_current_ns->proc_name
  41 +         && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
  42 +       continue; /* Already resolved.  */
  43 +
  44        if (gfc_current_ns->proc_name)
  45         gfc_current_locus = gfc_current_ns->proc_name->declared_at;
  46        gfc_resolve (gfc_current_ns);
  47 @@ -4231,8 +4235,28 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list)
  48    gfc_current_ns = gfc_global_ns_list;
  49    gfc_get_errors (NULL, &errors);
  50
  51 +  /* We first translate all modules to make sure that later parts
  52 +     of the program can use the decl. Then we translate the nonmodules.  */
  53 +
  54 +  for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
  55 +    {
  56 +      if (!gfc_current_ns->proc_name
  57 +         || gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
  58 +       continue;
  59 +
  60 +      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
  61 +      gfc_derived_types = gfc_current_ns->derived_types;
  62 +      gfc_generate_module_code (gfc_current_ns);
  63 +      gfc_current_ns->translated = 1;
  64 +    }
  65 +
  66 +  gfc_current_ns = gfc_global_ns_list;
  67    for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
  68      {
  69 +      if (gfc_current_ns->proc_name
  70 +         && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
  71 +       continue;
  72 +
  73        gfc_current_locus = gfc_current_ns->proc_name->declared_at;
  74        gfc_derived_types = gfc_current_ns->derived_types;
  75        gfc_generate_code (gfc_current_ns);
  76 @@ -4243,7 +4267,16 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list)
  77    gfc_current_ns = gfc_global_ns_list;
  78    for (;gfc_current_ns;)
  79      {
  80 -      gfc_namespace *ns = gfc_current_ns->sibling;
  81 +      gfc_namespace *ns;
  82 +
  83 +      if (gfc_current_ns->proc_name
  84 +         && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
  85 +       {
  86 +         gfc_current_ns = gfc_current_ns->sibling;
  87 +         continue;
  88 +       }
  89 +
  90 +      ns = gfc_current_ns->sibling;
  91        gfc_derived_types = gfc_current_ns->derived_types;
  92        gfc_done_2 ();
  93        gfc_current_ns = ns;
  94 @@ -4375,16 +4408,18 @@ loop:
  95    if (s.state == COMP_MODULE)
  96      {
  97        gfc_dump_module (s.sym->name, errors_before == errors);
  98 -      if (errors == 0)
  99 -       gfc_generate_module_code (gfc_current_ns);
 100 -      pop_state ();
 101        if (!gfc_option.flag_whole_file)
 102 -       gfc_done_2 ();
 103 +       {
 104 +         if (errors == 0)
 105 +           gfc_generate_module_code (gfc_current_ns);
 106 +         pop_state ();
 107 +         gfc_done_2 ();
 108 +       }
 109        else
 110         {
 111           gfc_current_ns->derived_types = gfc_derived_types;
 112           gfc_derived_types = NULL;
 113 -         gfc_current_ns = NULL;
 114 +         goto prog_units;
 115         }
 116      }
 117    else
 118 @@ -4429,10 +4464,12 @@ prog_units:
 119         = gfc_option.dump_fortran_original ? gfc_global_ns_list : NULL;
 120
 121    for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
 122 -    {
 123 -      gfc_dump_parse_tree (gfc_current_ns, stdout);
 124 -      fputs ("------------------------------------------\n\n", stdout);
 125 -    }
 126 +    if (!gfc_current_ns->proc_name
 127 +       || gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
 128 +      {
 129 +       gfc_dump_parse_tree (gfc_current_ns, stdout);
 130 +       fputs ("------------------------------------------\n\n", stdout);
 131 +      }
 132
 133    /* Do the translation.  */
 134    translate_all_program_units (gfc_global_ns_list);
 135 new file mode 100644
 136 index 0000000..31faeaa
 137 --- /dev/null
 138 +++ b/gcc/testsuite/gfortran.dg/whole_file_33.f90
 139 @@ -0,0 +1,50 @@
 140 +! { dg-do compile }
 141 +!
 142 +! PR fortran/48588
 143 +!
 144 +! Contributed by Andres Legarra.
 145 +!
 146 +
 147 +MODULE LA_PRECISION
 148 +IMPLICIT NONE
 149 +INTEGER, PARAMETER :: dp = KIND(1.0D0)
 150 +END MODULE LA_PRECISION
 151 +
 152 +module lapack90
 153 +INTERFACE
 154 +  SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
 155 +    USE la_precision, ONLY: wp => dp
 156 +    IMPLICIT NONE
 157 +    INTEGER, INTENT(OUT), OPTIONAL         :: INFO
 158 +    INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
 159 +    REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
 160 +  END SUBROUTINE DGESV_F90
 161 +END INTERFACE
 162 +end module
 163 +
 164 +SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
 165 +  USE la_precision, ONLY: wp => dp
 166 +  IMPLICIT NONE
 167 +  INTEGER, INTENT(OUT), OPTIONAL         :: INFO
 168 +  INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
 169 +  REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
 170 +END SUBROUTINE DGESV_F90
 171 +
 172 +MODULE DENSEOP
 173 +  USE LAPACK90
 174 +  implicit none
 175 +  integer, parameter :: r8 = SELECTED_REAL_KIND( 15, 307 )
 176 +  real(r8)::denseop_tol=1.d-50
 177 +
 178 +  CONTAINS
 179 +
 180 +  SUBROUTINE GEINV8 (x)
 181 +   real(r8)::x(:,:)
 182 +   real(r8),allocatable::x_o(:,:)
 183 +   allocate(x_o(size(x,1),size(x,1)))
 184 +   CALL dgesv_f90(x,x_o)
 185 +   x=x_o
 186 +  END SUBROUTINE GEINV8
 187 +END MODULE DENSEOP
 188 +
 189 +! { dg-final { cleanup-modules "la_precision lapack90 denseop" } }
 190 --
 191 1.7.0.4
 192