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