git.ipfire.org Git - thirdparty/openembedded/openembedded-core-contrib.git/blob

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