re PR fortran/54107 ([F03] Memory hog with abstract interface)
[platform/upstream/gcc.git] / gcc / fortran / ChangeLog
1 2013-02-08  Mikael Morin  <mikael@gcc.gnu.org>
2
3         PR fortran/54107
4         * trans-types.c (gfc_get_function_type): Change a NULL backend_decl
5         to error_mark_node on entry.  Detect recursive types.  Build a variadic
6         procedure type if the type is recursive.  Restore the initial
7         backend_decl.
8
9 2013-02-07  Tobias Burnus  <burnus@net-b.de>
10
11         PR fortran/54339 
12         * gfortran.texi (Standards): Mention TS29113.
13         (Varying Length Character): Mention deferred-length
14         strings.
15         (Fortran 2003 Status): Add unlimited polymorphic.
16         (TS 29113 Status): Add TYPE(*) and DIMENSION(..).
17         (C Interop): Update the section about TS29113.
18
19 2013-02-06 Paul Thomas  <pault@gcc.gnu.org>
20
21         PR fortran/55789
22         * trans-array.c (trans_array_constructor): Remove condition
23         'dynamic' = true if the loop ubound is a VAR_DECL.
24
25 2013-02-04  Paul Thomas  <pault@gcc.gnu.org>
26
27         PR fortran/56008
28         PR fortran/47517
29         * trans-array.c (gfc_alloc_allocatable_for_assignment): Save
30         the lhs descriptor before it is modified for reallocation. Use
31         it to deallocate allocatable components in the reallocation
32         block.  Nullify allocatable components for newly (re)allocated
33         arrays.
34
35 2013-02-04  Mikael Morin  <mikael@gcc.gnu.org>
36
37         PR fortran/54195
38         * resolve.c (resolve_typebound_procedures): Recurse through
39         resolve_symbol.
40
41 2013-02-04  Mikael Morin  <mikael@gcc.gnu.org>
42
43         PR fortran/54107
44         PR fortran/54195
45         * gfortran.h (struct gfc_symbol): New field 'resolved'.
46         * resolve.c (resolve_fl_var_and_proc): Don't skip result symbols.
47         (resolve_symbol): Skip duplicate calls.  Don't check the current
48         namespace.
49
50 2013-02-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
51
52         PR fortran/50627
53         PR fortran/56054
54         * decl.c (gfc_match_end):  Remove half-ready namespace
55         from parent if the end of a block is missing.
56         * parse.c (parse_module):  Do not put namespace into
57         gsymbol on error.
58
59 2013-01-30  Tobias Burnus  <burnus@net-b.de>
60
61         PR fortran/56138
62         * trans-decl.c (gfc_trans_deferred_vars): Fix deferred-length
63         results for functions without extra result variable.
64
65 2013-01-29  Janus Weil  <janus@gcc.gnu.org>
66             Mikael Morin <mikael@gcc.gnu.org>
67
68         PR fortran/54107
69         * gfortran.h (gfc_component): Delete members 'formal' and 'formal_ns'.
70         (gfc_copy_formal_args,gfc_copy_formal_args_ppc,gfc_expr_replace_symbols,
71         gfc_expr_replace_comp): Delete.
72         (gfc_sym_get_dummy_args): New prototype.
73         * dependency.c (gfc_check_fncall_dependency): Use
74         'gfc_sym_get_dummy_args'.
75         * expr.c (gfc_is_constant_expr): Ditto.
76         (replace_symbol,gfc_expr_replace_symbols,replace_comp,
77         gfc_expr_replace_comp): Deleted.
78         * frontend-passes.c (doloop_code,do_function): Use
79         'gfc_sym_get_dummy_args'.
80         * interface.c (gfc_check_operator_interface,gfc_compare_interfaces,
81         gfc_procedure_use,gfc_ppc_use,gfc_arglist_matches_symbol,
82         gfc_check_typebound_override): Ditto.
83         * module.c (MOD_VERSION): Bump module version.
84         (mio_component): Do not read/write 'formal' and 'formal_ns'.
85         * resolve.c (resolve_procedure_interface,resolve_fl_derived0): Do not
86         copy formal args, but just keep a pointer to the interface.
87         (resolve_function,resolve_call,resolve_typebound_generic_call,
88         resolve_ppc_call,resolve_expr_ppc,generate_component_assignments,
89         resolve_fl_procedure,gfc_resolve_finalizers,check_generic_tbp_ambiguity,
90         resolve_typebound_procedure,check_uop_procedure): Use
91         'gfc_sym_get_dummy_args'.
92         * symbol.c (free_components): Do not free 'formal' and 'formal_ns'.
93         (gfc_copy_formal_args,gfc_copy_formal_args_ppc): Deleted.
94         (gfc_sym_get_dummy_args): New function.
95         * trans-array.c (get_array_charlen,gfc_walk_elemental_function_args):
96         Use 'gfc_sym_get_dummy_args'.
97         * trans-decl.c (build_function_decl,create_function_arglist,
98         build_entry_thunks,init_intent_out_dt,gfc_trans_deferred_vars,
99         add_argument_checking): Ditto.
100         * trans-expr.c (gfc_map_fcn_formal_to_actual,gfc_conv_procedure_call,
101         gfc_conv_statement_function): Ditto.
102         * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto.
103         * trans-types.c (create_fn_spec,gfc_get_function_type): Ditto.
104
105 2013-01-28  Tobias Burnus  <burnus@net-b.de>
106             Mikael Morin  <mikael@gcc.gnu.org>
107
108         PR fortran/53537
109         * symbol.c (gfc_find_sym_tree): Don't look for the symbol outside an
110         interface block.
111         (gfc_get_ha_symtree): Let gfc_find_sym_tree lookup the parent namespace.
112         * decl.c (gfc_match_data_decl): Ditto.
113         (variable_decl): Remove undeclared type error.
114         (gfc_match_import): Use renamed instead of original name.
115
116 2013-01-27 Paul Thomas  <pault@gcc.gnu.org>
117
118         PR fortran/55984
119         PR fortran/56047
120         * gfortran.h : Add associate_var to symbol_attr.
121         * resolve.c (resolve_assoc_var): Set associate_var attribute.
122         If the target class_ok is set, set it for the associate
123         variable.
124         * check.c (allocatable_check): Associate variables should not
125         have the allocatable attribute even if their symbols do.
126         * class.c (gfc_build_class_symbol): Symbols with associate_var
127         set will always have a good class container.
128
129 2013-01-23  Janus Weil  <janus@gcc.gnu.org>
130
131         PR fortran/56081
132         * resolve.c (resolve_select): Add argument 'select_type', reject
133         non-scalar expressions.
134         (resolve_select_type,resolve_code): Pass new argument to
135         'resolve_select'.
136
137 2013-01-23  Jakub Jelinek  <jakub@redhat.com>
138
139         PR fortran/56052
140         * trans-decl.c (gfc_get_symbol_decl): Set DECL_ARTIFICIAL
141         and DECL_IGNORED_P on select_type_temporary and don't set
142         DECL_BY_REFERENCE.
143
144 2013-01-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
145
146         PR fortran/55919
147         * scanner.c (add_path_to_list): Copy path to temporary and strip
148         trailing directory separators before calling stat().
149
150 2013-01-17  Richard Biener  <rguenther@suse.de>
151
152         * trans-stmt.c (gfc_trans_do): Conditionally compute countm1
153         dependent on sign of step, avoids repeated evaluation of
154         step sign test.  Avoid undefined overflow issues by using unsigned
155         arithmetic.
156
157 2013-01-16  Janus Weil  <janus@gcc.gnu.org>
158
159         PR fortran/55983
160         * class.c (find_typebound_proc_uop): Check for f2k_derived instead of
161         asserting it.
162
163 2013-01-16  Jakub Jelinek  <jakub@redhat.com>
164             Tobias Burnus  <burnus@net-b.de>
165
166         PR driver/55884
167         * lang.opt (fintrinsic-modules-path): Don't accept Joined.
168         (fintrinsic-modules-path=): New.
169         * options.c (gfc_handle_option, gfc_get_option_string,
170         gfc_get_option_string): Handle the latter.
171
172 2013-01-16  Jakub Jelinek  <jakub@redhat.com>
173
174         PR fortran/52865
175         * trans-stmt.c (gfc_trans_do): Put countm1-- before conditional
176         and use value of countm1 before the decrement in the condition.
177
178 2013-01-15  Paul Thomas  <pault@gcc.gnu.org>
179
180         PR fortran/54286
181         * expr.c (gfc_check_pointer_assign): Check for presence of
182         's2' before using it.
183
184 2013-01-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
185
186         PR fortran/55806
187         * frontend-passes.c (optimize_reduction):  New function,
188         including prototype.
189         (callback_reduction):  Likewise.
190         (gfc_run_passes):  Also run optimize_reduction.
191         (copy_walk_reduction_arg):  New function.
192         (dummy_code_callback):  New function.
193
194 2013-01-13  Jakub Jelinek  <jakub@redhat.com>
195
196         PR fortran/55935
197         * trans-expr.c (gfc_conv_structure): Call
198         unshare_expr_without_location on the ctor elements.
199
200 2013-01-13  Paul Thomas  <pault@gcc.gnu.org>
201
202         PR fortran/54286
203         * expr.c (gfc_check_pointer_assign): Ensure that both lvalue
204         and rvalue interfaces are presented to gfc_compare_interfaces.
205         Simplify references to interface names by using the symbols
206         themselves. Call gfc_compare_interfaces with s1 and s2 inter-
207         changed to overcome the asymmetry of this function. Do not
208         repeat the check for the presence of s1 and s2.
209
210 2013-01-12  Janus Weil  <janus@gcc.gnu.org>
211
212         PR fortran/55072
213         * trans-array.c (gfc_conv_array_parameter): No packing was done for
214         full arrays of derived type.
215
216 2013-01-08  Paul Thomas  <pault@gcc.gnu.org>
217
218         PR fortran/55868
219         * class.c (get_unique_type_string): Change $tar to STAR and
220         replace sprintf by strcpy where there is no formatting.
221         * decl.c (gfc_match_decl_type_spec): Change $tar to STAR.
222
223 2013-01-09  Mikael Morin  <mikael@gcc.gnu.org>
224
225         PR fortran/47203
226         * module.c (check_for_ambiguous): Get the current program unit using
227         gfc_current_ns.
228
229 2013-01-09  Tobias Burnus  <burnus@net-b.de>
230
231         PR fortran/55758
232         * resolve.c (resolve_symbol): Reject non-C_Bool logicals
233         in BIND(C) procedures with -std=f*.
234
235 2013-01-08  Paul Thomas  <pault@gcc.gnu.org>
236
237         PR fortran/55618
238         * trans-expr.c (gfc_conv_procedure_call): Dereference scalar
239         character function arguments to elemental procedures in
240         scalarization loops.
241
242 2013-01-07  Tobias Burnus  <burnus@net-b.de>
243
244         PR fortran/55763
245         * gfortran.h (gfc_check_assign_symbol): Update prototype.
246         * decl.c (add_init_expr_to_sym, do_parm): Update call.
247         * expr.c (gfc_check_assign_symbol): Handle BT_CLASS and
248         improve error location; support components.
249         (gfc_check_pointer_assign): Handle component assignments.
250         * resolve.c (resolve_fl_derived0): Call gfc_check_assign_symbol.
251         (resolve_values): Update call.
252         (resolve_structure_cons): Avoid double diagnostic.
253
254 2013-01-07  Tobias Burnus  <burnus@net-b.de>
255             Thomas Koenig  <tkoenig@gcc.gnu.org>
256
257         PR fortran/55852
258         * expr.c (gfc_build_intrinsic_call): Avoid clashes
259         with user's procedures.
260         * gfortran.h (gfc_build_intrinsic_call): Update prototype.
261         * simplify.c (gfc_simplify_size): Update call.
262         * class.c (finalization_scalarizer, finalization_get_offset,
263         finalizer_insert_packed_call, generate_finalization_wrapper):
264         Clean up by using gfc_build_intrinsic_call.
265
266 2013-01-07  Tobias Burnus  <burnus@net-b.de>
267
268         PR fortran/55763
269         * resolve.c (resolve_select_type): Reject intrinsic types for
270         a non-unlimited-polymorphic selector.
271
272 2013-01-06  Paul Thomas  <pault@gcc.gnu.org>
273
274         PR fortran/53876
275         PR fortran/54990
276         PR fortran/54992
277         * trans-array.c (build_array_ref): Check the TYPE_CANONICAL
278         to see if it is GFC_CLASS_TYPE_P.
279         * trans-expr.c (gfc_get_vptr_from_expr): The same.
280         (gfc_conv_class_to_class): If the types are not the same,
281         cast parmese->expr to the type of ctree.
282         * trans-types.c (gfc_get_derived_type): GFC_CLASS_TYPE_P of
283         CLASS components must be set.
284
285 2013-01-06  Mikael Morin  <mikael@gcc.gnu.org>
286
287         PR fortran/42769
288         PR fortran/45836
289         PR fortran/45900
290         * module.c (read_module): Don't reuse local symtree if the associated
291         symbol isn't exactly the one wanted.  Don't reuse local symtree if it is
292         ambiguous.
293         * resolve.c (resolve_call): Use symtree's name instead of symbol's to
294         lookup the symtree.
295
296 2013-01-05  Steven G. Kargl  <kargl@gcc.gnu.org>
297             Mikael Morin  <mikael@gcc.gnu.org>
298
299         PR fortran/55827
300         * class.c (gfc_fix_class_refs): Adapt ts initialization for the case
301         e->symtree == NULL.
302         * trans-expr.c (gfc_conv_function_expr): Init sym earlier. Use it.
303
304 2013-01-05  Tobias Burnus  <burnus@net-b.de>
305
306         * class.c (finalize_component): Used passed offset expr.
307         (finalization_get_offset): New static function.
308         (finalizer_insert_packed_call, generate_finalization_wrapper): Use it
309         to handle noncontiguous arrays.
310
311 2013-01-04  Tobias Burnus  <burnus@net-b.de>
312
313         * trans.c (gfc_build_final_call): New function.
314         * trans.h (gfc_build_final_call, gfc_conv_scalar_to_descriptor):
315         New function prototypes.
316         * trans-expr.c (gfc_conv_scalar_to_descriptor): Renamed from
317         conv_scalar_to_descriptor, removed static attribute.
318         (gfc_conv_procedure_call): Honor renaming.
319
320 2013-01-04  Tobias Burnus  <burnus@net-b.de>
321
322         * intrinsic.c (add_functions): New internal intrinsic
323         function GFC_PREFIX ("stride").
324         * gfortran.h (gfc_isym_id): Add GFC_ISYM_STRIDE.
325         * intrinsic.h (gfc_resolve_stride): New prototypes.
326         * iresolve.c (gfc_resolve_stride): New function.
327         * trans-intrinsic.c (conv_intrinsic_stride): New static
328         function.
329         (gfc_conv_intrinsic_function): Use it.
330
331 2013-01-04  Tobias Burnus  <burnus@net-b.de>
332
333         * class.c (gfc_find_intrinsic_vtab): Add _final
334         component.
335         * decl.c (gfc_match_null): Remove superfluous
336         variadic argument to gfc_match.
337
338 2013-01-04  Paul Thomas  <pault@gcc.gnu.org>
339
340         PR fortran/55172
341         * match.c (copy_ts_from_selector_to_associate): Remove call to
342         gfc_resolve_expr and replace it with explicit setting of the
343         array reference type.
344         * resolve.c (resolve_select_type): It is an error if the
345         selector is coindexed.
346
347 2013-01-04  Tobias Burnus  <burnus@net-b.de>
348
349         PR fortran/55763
350         * decl.c (gfc_match_null): Parse and reject MOLD.
351
352 2013-01-04  Tobias Burnus  <burnus@net-b.de>
353
354         PR fortran/55854
355         PR fortran/55763
356         * class.c (gfc_class_null_initializer): Fix finding the vtab.
357         (gfc_find_intrinsic_vtab): Use BT_VOID for some components.
358
359 2013-01-03  Janus Weil  <janus@gcc.gnu.org>
360
361         PR fortran/55855
362         * expr.c (gfc_check_assign): Use 'gfc_expr_attr' to evaluate attributes
363         of rvalue. Correct hyphenation in error message.
364
365 2013-01-03  Jakub Jelinek  <jakub@redhat.com>
366
367         * gfortranspec.c (lang_specific_driver): Update copyright notice
368         dates.
369 \f
370 Copyright (C) 2013 Free Software Foundation, Inc.
371
372 Copying and distribution of this file, with or without modification,
373 are permitted in any medium without royalty provided the copyright
374 notice and this notice are preserved.