Bug Summary

File:build/gcc/fortran/options.c
Warning:line 353, column 26
Use of memory after it is freed

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name options.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -fno-rounding-math -mconstructor-aliases -munwind-tables -target-cpu x86-64 -fno-split-dwarf-inlining -debugger-tuning=gdb -resource-dir /usr/lib64/clang/11.0.0 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10/backward -internal-isystem /usr/local/include -internal-isystem /usr/lib64/clang/11.0.0/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-error=format-diag -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -o /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2021-01-16-135054-17580-1/report-PRkQV4.plist -x c++ /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/options.c
1/* Parse and display command line options.
2 Copyright (C) 2000-2021 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21#include "config.h"
22#include "system.h"
23#include "coretypes.h"
24#include "target.h"
25#include "tree.h"
26#include "gfortran.h"
27#include "diagnostic.h" /* For global_dc. */
28#include "opts.h"
29#include "toplev.h" /* For save_decoded_options. */
30#include "cpp.h"
31#include "langhooks.h"
32
33gfc_option_t gfc_option;
34
35#define SET_FLAG(flag, condition, on_value, off_value) \
36 do \
37 { \
38 if (condition) \
39 flag = (on_value); \
40 else \
41 flag = (off_value); \
42 } while (0)
43
44#define SET_BITFLAG2(m) m
45
46#define SET_BITFLAG(flag, condition, value) \
47 SET_BITFLAG2 (SET_FLAG (flag, condition, (flag | (value)), (flag & ~(value))))
48
49
50/* Set flags that control warnings and errors for different
51 Fortran standards to their default values. Keep in sync with
52 libgfortran/runtime/compile_options.c (init_compile_options). */
53
54static void
55set_default_std_flags (void)
56{
57 gfc_option.allow_std = GFC_STD_F95_OBS(1<<1) | GFC_STD_F95_DEL(1<<2)
58 | GFC_STD_F2003(1<<4) | GFC_STD_F2008(1<<7) | GFC_STD_F95(1<<3) | GFC_STD_F77(1<<0)
59 | GFC_STD_F2008_OBS(1<<8) | GFC_STD_GNU(1<<5) | GFC_STD_LEGACY(1<<6)
60 | GFC_STD_F2018(1<<9) | GFC_STD_F2018_DEL(1<<11) | GFC_STD_F2018_OBS(1<<10);
61 gfc_option.warn_std = GFC_STD_F2018_DEL(1<<11) | GFC_STD_F95_DEL(1<<2) | GFC_STD_LEGACY(1<<6);
62}
63
64/* Set (or unset) the DEC extension flags. */
65
66static void
67set_dec_flags (int value)
68{
69 /* Set (or unset) other DEC compatibility extensions. */
70 SET_BITFLAG (flag_dollar_okglobal_options.x_flag_dollar_ok, value, value);
71 SET_BITFLAG (flag_cray_pointerglobal_options.x_flag_cray_pointer, value, value);
72 SET_BITFLAG (flag_dec_structureglobal_options.x_flag_dec_structure, value, value);
73 SET_BITFLAG (flag_dec_intrinsic_intsglobal_options.x_flag_dec_intrinsic_ints, value, value);
74 SET_BITFLAG (flag_dec_staticglobal_options.x_flag_dec_static, value, value);
75 SET_BITFLAG (flag_dec_mathglobal_options.x_flag_dec_math, value, value);
76 SET_BITFLAG (flag_dec_includeglobal_options.x_flag_dec_include, value, value);
77 SET_BITFLAG (flag_dec_format_defaultsglobal_options.x_flag_dec_format_defaults, value, value);
78 SET_BITFLAG (flag_dec_blank_format_itemglobal_options.x_flag_dec_blank_format_item, value, value);
79 SET_BITFLAG (flag_dec_char_conversionsglobal_options.x_flag_dec_char_conversions, value, value);
80}
81
82/* Finalize DEC flags. */
83
84static void
85post_dec_flags (int value)
86{
87 /* Don't warn for legacy code if -fdec is given; however, setting -fno-dec
88 does not force these warnings. We make one final determination on this
89 at the end because -std= is always set first; thus, we can avoid
90 clobbering the user's desired standard settings in gfc_handle_option
91 e.g. when -fdec and -fno-dec are both given. */
92 if (value)
93 {
94 gfc_option.allow_std |= GFC_STD_F95_OBS(1<<1) | GFC_STD_F95_DEL(1<<2)
95 | GFC_STD_GNU(1<<5) | GFC_STD_LEGACY(1<<6);
96 gfc_option.warn_std &= ~(GFC_STD_LEGACY(1<<6) | GFC_STD_F95_DEL(1<<2));
97 }
98}
99
100/* Enable (or disable) -finit-local-zero. */
101
102static void
103set_init_local_zero (int value)
104{
105 gfc_option.flag_init_integer_value = 0;
106 gfc_option.flag_init_character_value = (char)0;
107
108 SET_FLAG (gfc_option.flag_init_integer, value, GFC_INIT_INTEGER_ON,
109 GFC_INIT_INTEGER_OFF);
110 SET_FLAG (gfc_option.flag_init_logical, value, GFC_INIT_LOGICAL_FALSE,
111 GFC_INIT_LOGICAL_OFF);
112 SET_FLAG (gfc_option.flag_init_character, value, GFC_INIT_CHARACTER_ON,
113 GFC_INIT_CHARACTER_OFF);
114 SET_FLAG (flag_init_realglobal_options.x_flag_init_real, value, GFC_INIT_REAL_ZERO, GFC_INIT_REAL_OFF);
115}
116
117/* Return language mask for Fortran options. */
118
119unsigned int
120gfc_option_lang_mask (void)
121{
122 return CL_Fortran(1U << 7);
123}
124
125/* Initialize options structure OPTS. */
126
127void
128gfc_init_options_struct (struct gcc_options *opts)
129{
130 opts->x_flag_errno_math = 0;
131 opts->frontend_set_flag_errno_math = true;
132 opts->x_flag_associative_math = -1;
133 opts->frontend_set_flag_associative_math = true;
134}
135
136/* Get ready for options handling. Keep in sync with
137 libgfortran/runtime/compile_options.c (init_compile_options). */
138
139void
140gfc_init_options (unsigned int decoded_options_count,
141 struct cl_decoded_option *decoded_options)
142{
143 gfc_source_file = NULL__null;
144 gfc_option.module_dir = NULL__null;
145 gfc_option.source_form = FORM_UNKNOWN;
146 gfc_option.max_continue_fixed = 255;
147 gfc_option.max_continue_free = 255;
148 gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN63;
149 gfc_option.max_errors = 25;
150
151 gfc_option.flag_preprocessed = 0;
152 gfc_option.flag_d_lines = -1;
153 set_init_local_zero (0);
154
155 gfc_option.fpe = 0;
156 /* All except GFC_FPE_INEXACT. */
157 gfc_option.fpe_summary = GFC_FPE_INVALID1 | GFC_FPE_DENORMAL2
158 | GFC_FPE_ZERO4 | GFC_FPE_OVERFLOW8
159 | GFC_FPE_UNDERFLOW16;
160 gfc_option.rtcheck = 0;
161
162 /* ??? Wmissing-include-dirs is disabled by default in C/C++ but
163 enabled by default in Fortran. Ideally, we should express this
164 in .opt, but that is not supported yet. */
165 SET_OPTION_IF_UNSET (&global_options, &global_options_set,do { if (!(&global_options_set)->x_cpp_warn_missing_include_dirs
) (&global_options)->x_cpp_warn_missing_include_dirs =
1; } while (false)
166 cpp_warn_missing_include_dirs, 1)do { if (!(&global_options_set)->x_cpp_warn_missing_include_dirs
) (&global_options)->x_cpp_warn_missing_include_dirs =
1; } while (false)
;
167
168 set_dec_flags (0);
169
170 set_default_std_flags ();
171
172 /* Initialize cpp-related options. */
173 gfc_cpp_init_options (decoded_options_count, decoded_options);
174 gfc_diagnostics_init ();
175}
176
177
178/* Determine the source form from the filename extension. We assume
179 case insensitivity. */
180
181static gfc_source_form
182form_from_filename (const char *filename)
183{
184 static const struct
185 {
186 const char *extension;
187 gfc_source_form form;
188 }
189 exttype[] =
190 {
191 {
192 ".f90", FORM_FREE}
193 ,
194 {
195 ".f95", FORM_FREE}
196 ,
197 {
198 ".f03", FORM_FREE}
199 ,
200 {
201 ".f08", FORM_FREE}
202 ,
203 {
204 ".f", FORM_FIXED}
205 ,
206 {
207 ".for", FORM_FIXED}
208 ,
209 {
210 ".ftn", FORM_FIXED}
211 ,
212 {
213 "", FORM_UNKNOWN}
214 }; /* sentinel value */
215
216 gfc_source_form f_form;
217 const char *fileext;
218 int i;
219
220 /* Find end of file name. Note, filename is either a NULL pointer or
221 a NUL terminated string. */
222 i = 0;
223 while (filename[i] != '\0')
224 i++;
225
226 /* Find last period. */
227 while (i >= 0 && (filename[i] != '.'))
228 i--;
229
230 /* Did we see a file extension? */
231 if (i < 0)
232 return FORM_UNKNOWN; /* Nope */
233
234 /* Get file extension and compare it to others. */
235 fileext = &(filename[i]);
236
237 i = -1;
238 f_form = FORM_UNKNOWN;
239 do
240 {
241 i++;
242 if (strcasecmp (fileext, exttype[i].extension) == 0)
243 {
244 f_form = exttype[i].form;
245 break;
246 }
247 }
248 while (exttype[i].form != FORM_UNKNOWN);
249
250 return f_form;
251}
252
253
254/* Finalize commandline options. */
255
256bool
257gfc_post_options (const char **pfilename)
258{
259 const char *filename = *pfilename, *canon_source_file = NULL__null;
260 char *source_path;
261 int i;
262
263 /* Finalize DEC flags. */
264 post_dec_flags (flag_decglobal_options.x_flag_dec);
265
266 /* Excess precision other than "fast" requires front-end
267 support. */
268 if (flag_excess_precisionglobal_options.x_flag_excess_precision == EXCESS_PRECISION_STANDARD)
1
Assuming field 'x_flag_excess_precision' is not equal to EXCESS_PRECISION_STANDARD
2
Taking false branch
269 sorry ("%<-fexcess-precision=standard%> for Fortran");
270 flag_excess_precisionglobal_options.x_flag_excess_precision = EXCESS_PRECISION_FAST;
271
272 /* Fortran allows associative math - but we cannot reassociate if
273 we want traps or signed zeros. Cf. also flag_protect_parens. */
274 if (flag_associative_mathglobal_options.x_flag_associative_math == -1)
3
Assuming the condition is false
4
Taking false branch
275 flag_associative_mathglobal_options.x_flag_associative_math = (!flag_trapping_mathglobal_options.x_flag_trapping_math && !flag_signed_zerosglobal_options.x_flag_signed_zeros);
276
277 if (flag_protect_parensglobal_options.x_flag_protect_parens == -1)
5
Assuming the condition is false
6
Taking false branch
278 flag_protect_parensglobal_options.x_flag_protect_parens = !optimize_fastglobal_options.x_optimize_fast;
279
280 /* -Ofast sets implies -fstack-arrays unless an explicit size is set for
281 stack arrays. */
282 if (flag_stack_arraysglobal_options.x_flag_stack_arrays == -1 && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2)
7
Assuming the condition is false
283 flag_stack_arraysglobal_options.x_flag_stack_arrays = optimize_fastglobal_options.x_optimize_fast;
284
285 /* By default, disable (re)allocation during assignment for -std=f95,
286 and enable it for F2003/F2008/GNU/Legacy. */
287 if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs == -1)
8
Assuming the condition is false
9
Taking false branch
288 {
289 if (gfc_option.allow_std & GFC_STD_F2003(1<<4))
290 flag_realloc_lhsglobal_options.x_flag_realloc_lhs = 1;
291 else
292 flag_realloc_lhsglobal_options.x_flag_realloc_lhs = 0;
293 }
294
295 /* -fbounds-check is equivalent to -fcheck=bounds */
296 if (flag_bounds_checkglobal_options.x_flag_bounds_check)
10
Assuming field 'x_flag_bounds_check' is 0
11
Taking false branch
297 gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS(1<<0);
298
299 if (flag_compare_debugglobal_options.x_flag_compare_debug)
12
Assuming field 'x_flag_compare_debug' is 0
13
Taking false branch
300 flag_dump_fortran_originalglobal_options.x_flag_dump_fortran_original = 0;
301
302 /* Make -fmax-errors visible to gfortran's diagnostic machinery. */
303 if (global_options_set.x_flag_max_errors)
14
Assuming field 'x_flag_max_errors' is 0
15
Taking false branch
304 gfc_option.max_errors = flag_max_errorsglobal_options.x_flag_max_errors;
305
306 /* Verify the input file name. */
307 if (!filename || strcmp (filename, "-") == 0)
16
Assuming 'filename' is non-null
17
Assuming the condition is false
18
Taking false branch
308 {
309 filename = "";
310 }
311
312 if (gfc_option.flag_preprocessed)
19
Assuming field 'flag_preprocessed' is 0
20
Taking false branch
313 {
314 /* For preprocessed files, if the first tokens are of the form # NUM.
315 handle the directives so we know the original file name. */
316 gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
317 if (gfc_source_file == NULL__null)
318 gfc_source_file = filename;
319 else
320 *pfilename = gfc_source_file;
321 }
322 else
323 gfc_source_file = filename;
324
325 if (canon_source_file
20.1
'canon_source_file' is equal to NULL
== NULL__null)
21
Taking true branch
326 canon_source_file = gfc_source_file;
327
328 /* Adds the path where the source file is to the list of include files. */
329
330 i = strlen (canon_source_file);
331 while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i])(((canon_source_file[i]) == '/') || (((canon_source_file[i]) ==
'\\') && (0)))
)
22
Assuming 'i' is <= 0
332 i--;
333
334 if (i
22.1
'i' is equal to 0
!= 0)
23
Taking false branch
335 {
336 source_path = (char *) alloca (i + 1)__builtin_alloca(i + 1);
337 memcpy (source_path, canon_source_file, i);
338 source_path[i] = 0;
339 gfc_add_include_path (source_path, true, true, true);
340 }
341 else
342 gfc_add_include_path (".", true, true, true);
343
344 if (canon_source_file != gfc_source_file)
24
Assuming 'canon_source_file' is not equal to 'gfc_source_file'
25
Taking true branch
345 free (CONST_CAST (char *, canon_source_file)(const_cast<char *> ((canon_source_file))));
26
Memory is released
346
347 /* Decide which form the file will be read in as. */
348
349 if (gfc_option.source_form != FORM_UNKNOWN)
27
Assuming field 'source_form' is equal to FORM_UNKNOWN
28
Taking false branch
350 gfc_current_form = gfc_option.source_form;
351 else
352 {
353 gfc_current_form = form_from_filename (filename);
29
Use of memory after it is freed
354
355 if (gfc_current_form == FORM_UNKNOWN)
356 {
357 gfc_current_form = FORM_FREE;
358 main_input_filenameglobal_options.x_main_input_filename = filename;
359 gfc_warning_now (0, "Reading file %qs as free form",
360 (filename[0] == '\0') ? "<stdin>" : filename);
361 }
362 }
363
364 /* If the user specified -fd-lines-as-{code|comments} verify that we're
365 in fixed form. */
366 if (gfc_current_form == FORM_FREE)
367 {
368 if (gfc_option.flag_d_lines == 0)
369 gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect "
370 "in free form");
371 else if (gfc_option.flag_d_lines == 1)
372 gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form");
373
374 if (warn_line_truncationglobal_options.x_warn_line_truncation == -1)
375 warn_line_truncationglobal_options.x_warn_line_truncation = 1;
376
377 /* Enable -Werror=line-truncation when -Werror and -Wno-error have
378 not been set. */
379 if (warn_line_truncationglobal_options.x_warn_line_truncation && !global_options_set.x_warnings_are_errors
380 && (global_dc->classify_diagnostic[OPT_Wline_truncation] ==
381 DK_UNSPECIFIED))
382 diagnostic_classify_diagnostic (global_dc, OPT_Wline_truncation,
383 DK_ERROR, UNKNOWN_LOCATION((location_t) 0));
384 }
385 else
386 {
387 /* With -fdec, set -fd-lines-as-comments by default in fixed form. */
388 if (flag_decglobal_options.x_flag_dec && gfc_option.flag_d_lines == -1)
389 gfc_option.flag_d_lines = 0;
390
391 if (warn_line_truncationglobal_options.x_warn_line_truncation == -1)
392 warn_line_truncationglobal_options.x_warn_line_truncation = 0;
393 }
394
395 /* If -pedantic, warn about the use of GNU extensions. */
396 if (pedanticglobal_options.x_pedantic && (gfc_option.allow_std & GFC_STD_GNU(1<<5)) != 0)
397 gfc_option.warn_std |= GFC_STD_GNU(1<<5);
398 /* -std=legacy -pedantic is effectively -std=gnu. */
399 if (pedanticglobal_options.x_pedantic && (gfc_option.allow_std & GFC_STD_LEGACY(1<<6)) != 0)
400 gfc_option.warn_std |= GFC_STD_F95_OBS(1<<1) | GFC_STD_F95_DEL(1<<2) | GFC_STD_LEGACY(1<<6);
401
402 /* If the user didn't explicitly specify -f(no)-second-underscore we
403 use it if we're trying to be compatible with f2c, and not
404 otherwise. */
405 if (flag_second_underscoreglobal_options.x_flag_second_underscore == -1)
406 flag_second_underscoreglobal_options.x_flag_second_underscore = flag_f2cglobal_options.x_flag_f2c;
407
408 if (!flag_automaticglobal_options.x_flag_automatic && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != -2
409 && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != 0)
410 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
411 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size);
412 else if (!flag_automaticglobal_options.x_flag_automatic && flag_recursiveglobal_options.x_flag_recursive)
413 gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
414 "overwrites %<-frecursive%>");
415 else if (!flag_automaticglobal_options.x_flag_automatic && (flag_openmpglobal_options.x_flag_openmp || flag_openaccglobal_options.x_flag_openacc))
416 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> "
417 "implied by %qs", flag_openmpglobal_options.x_flag_openmp ? "-fopenmp" : "-fopenacc");
418 else if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != -2 && flag_recursiveglobal_options.x_flag_recursive)
419 gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
420 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size);
421 else if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != -2 && (flag_openmpglobal_options.x_flag_openmp || flag_openaccglobal_options.x_flag_openacc))
422 gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites "
423 "%<-frecursive%> implied by %qs", flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size,
424 flag_openmpglobal_options.x_flag_openmp ? "-fopenmp" : "-fopenacc");
425
426 /* Implement -frecursive as -fmax-stack-var-size=-1. */
427 if (flag_recursiveglobal_options.x_flag_recursive)
428 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = -1;
429
430 /* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
431 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2 && flag_automaticglobal_options.x_flag_automatic
432 && (flag_openmpglobal_options.x_flag_openmp || flag_openaccglobal_options.x_flag_openacc))
433 {
434 flag_recursiveglobal_options.x_flag_recursive = 1;
435 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = -1;
436 }
437
438 /* Set flag_stack_arrays correctly. */
439 if (flag_stack_arraysglobal_options.x_flag_stack_arrays == -1)
440 flag_stack_arraysglobal_options.x_flag_stack_arrays = 0;
441
442 /* Set default. */
443 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2)
444 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = 65536;
445
446 /* Implement -fno-automatic as -fmax-stack-var-size=0. */
447 if (!flag_automaticglobal_options.x_flag_automatic)
448 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = 0;
449
450 /* If the user did not specify an inline matmul limit, inline up to the BLAS
451 limit or up to 30 if no external BLAS is specified. */
452
453 if (flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit < 0)
454 {
455 if (flag_external_blasglobal_options.x_flag_external_blas)
456 flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit = flag_blas_matmul_limitglobal_options.x_flag_blas_matmul_limit;
457 else
458 flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit = 30;
459 }
460
461 /* Optimization implies front end optimization, unless the user
462 specified it directly. */
463
464 if (flag_frontend_optimizeglobal_options.x_flag_frontend_optimize == -1)
465 flag_frontend_optimizeglobal_options.x_flag_frontend_optimize = optimizeglobal_options.x_optimize && !optimize_debugglobal_options.x_optimize_debug;
466
467 /* Same for front end loop interchange. */
468
469 if (flag_frontend_loop_interchangeglobal_options.x_flag_frontend_loop_interchange == -1)
470 flag_frontend_loop_interchangeglobal_options.x_flag_frontend_loop_interchange = optimizeglobal_options.x_optimize;
471
472 /* Do inline packing by default if optimizing, but not if
473 optimizing for size. */
474 if (flag_inline_arg_packingglobal_options.x_flag_inline_arg_packing == -1)
475 flag_inline_arg_packingglobal_options.x_flag_inline_arg_packing = optimizeglobal_options.x_optimize && !optimize_sizeglobal_options.x_optimize_size;
476
477 if (flag_max_array_constructorglobal_options.x_flag_max_array_constructor < 65535)
478 flag_max_array_constructorglobal_options.x_flag_max_array_constructor = 65535;
479
480 if (flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length != 0 && flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length < 7)
481 gfc_fatal_error ("Fixed line length must be at least seven");
482
483 if (flag_free_line_lengthglobal_options.x_flag_free_line_length != 0 && flag_free_line_lengthglobal_options.x_flag_free_line_length < 4)
484 gfc_fatal_error ("Free line length must be at least three");
485
486 if (flag_max_subrecord_lengthglobal_options.x_flag_max_subrecord_length > MAX_SUBRECORD_LENGTH2147483639)
487 gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
488 MAX_SUBRECORD_LENGTH2147483639);
489
490 gfc_cpp_post_options ();
491
492 if (gfc_option.allow_std & GFC_STD_F2008(1<<7))
493 lang_hooks.name = "GNU Fortran2008";
494 else if (gfc_option.allow_std & GFC_STD_F2003(1<<4))
495 lang_hooks.name = "GNU Fortran2003";
496
497 return gfc_cpp_preprocess_only ();
498}
499
500
501static void
502gfc_handle_module_path_options (const char *arg)
503{
504
505 if (gfc_option.module_dir != NULL__null)
506 gfc_fatal_error ("gfortran: Only one %<-J%> option allowed");
507
508 gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2)((char *) xcalloc ((strlen (arg) + 2), sizeof (char)));
509 strcpy (gfc_option.module_dir, arg);
510
511 gfc_add_include_path (gfc_option.module_dir, true, false, true);
512
513 strcat (gfc_option.module_dir, "/");
514}
515
516
517/* Handle options -ffpe-trap= and -ffpe-summary=. */
518
519static void
520gfc_handle_fpe_option (const char *arg, bool trap)
521{
522 int result, pos = 0, n;
523 /* precision is a backwards compatibility alias for inexact. */
524 static const char * const exception[] = { "invalid", "denormal", "zero",
525 "overflow", "underflow",
526 "inexact", "precision", NULL__null };
527 static const int opt_exception[] = { GFC_FPE_INVALID1, GFC_FPE_DENORMAL2,
528 GFC_FPE_ZERO4, GFC_FPE_OVERFLOW8,
529 GFC_FPE_UNDERFLOW16, GFC_FPE_INEXACT32,
530 GFC_FPE_INEXACT32,
531 0 };
532
533 /* As the default for -ffpe-summary= is nonzero, set it to 0. */
534 if (!trap)
535 gfc_option.fpe_summary = 0;
536
537 while (*arg)
538 {
539 while (*arg == ',')
540 arg++;
541
542 while (arg[pos] && arg[pos] != ',')
543 pos++;
544
545 result = 0;
546 if (!trap && strncmp ("none", arg, pos) == 0)
547 {
548 gfc_option.fpe_summary = 0;
549 arg += pos;
550 pos = 0;
551 continue;
552 }
553 else if (!trap && strncmp ("all", arg, pos) == 0)
554 {
555 gfc_option.fpe_summary = GFC_FPE_INVALID1 | GFC_FPE_DENORMAL2
556 | GFC_FPE_ZERO4 | GFC_FPE_OVERFLOW8
557 | GFC_FPE_UNDERFLOW16 | GFC_FPE_INEXACT32;
558 arg += pos;
559 pos = 0;
560 continue;
561 }
562 else
563 for (n = 0; exception[n] != NULL__null; n++)
564 {
565 if (exception[n] && strncmp (exception[n], arg, pos) == 0)
566 {
567 if (trap)
568 gfc_option.fpe |= opt_exception[n];
569 else
570 gfc_option.fpe_summary |= opt_exception[n];
571 arg += pos;
572 pos = 0;
573 result = 1;
574 break;
575 }
576 }
577 if (!result && !trap)
578 gfc_fatal_error ("Argument to %<-ffpe-trap%> is not valid: %s", arg);
579 else if (!result)
580 gfc_fatal_error ("Argument to %<-ffpe-summary%> is not valid: %s", arg);
581
582 }
583}
584
585
586static void
587gfc_handle_runtime_check_option (const char *arg)
588{
589 int result, pos = 0, n;
590 static const char * const optname[] = { "all", "bounds", "array-temps",
591 "recursion", "do", "pointer",
592 "mem", "bits", NULL__null };
593 static const int optmask[] = { GFC_RTCHECK_ALL((1<<0) | (1<<1) | (1<<2) | (1<<3) | (
1<<4) | (1<<5) | (1<<6))
, GFC_RTCHECK_BOUNDS(1<<0),
594 GFC_RTCHECK_ARRAY_TEMPS(1<<1),
595 GFC_RTCHECK_RECURSION(1<<2), GFC_RTCHECK_DO(1<<3),
596 GFC_RTCHECK_POINTER(1<<4), GFC_RTCHECK_MEM(1<<5),
597 GFC_RTCHECK_BITS(1<<6), 0 };
598
599 while (*arg)
600 {
601 while (*arg == ',')
602 arg++;
603
604 while (arg[pos] && arg[pos] != ',')
605 pos++;
606
607 result = 0;
608 for (n = 0; optname[n] != NULL__null; n++)
609 {
610 if (optname[n] && strncmp (optname[n], arg, pos) == 0)
611 {
612 gfc_option.rtcheck |= optmask[n];
613 arg += pos;
614 pos = 0;
615 result = 1;
616 break;
617 }
618 else if (optname[n] && pos > 3 && gfc_str_startswith (arg, "no-")(strncmp ((arg), ("no-"), strlen ("no-")) == 0)
619 && strncmp (optname[n], arg+3, pos-3) == 0)
620 {
621 gfc_option.rtcheck &= ~optmask[n];
622 arg += pos;
623 pos = 0;
624 result = 1;
625 break;
626 }
627 }
628 if (!result)
629 gfc_fatal_error ("Argument to %<-fcheck%> is not valid: %s", arg);
630 }
631}
632
633
634/* Handle command-line options. Returns 0 if unrecognized, 1 if
635 recognized and handled. */
636
637bool
638gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INTlong value,
639 int kind ATTRIBUTE_UNUSED__attribute__ ((__unused__)), location_t loc ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
640 const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
641{
642 bool result = true;
643 enum opt_code code = (enum opt_code) scode;
644
645 if (gfc_cpp_handle_option (scode, arg, value) == 1)
646 return true;
647
648 switch (code)
649 {
650 default:
651 if (cl_options[code].flags & gfc_option_lang_mask ())
652 break;
653 result = false;
654 break;
655
656 case OPT_fcheck_array_temporaries:
657 SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS(1<<1));
658 break;
659
660 case OPT_fd_lines_as_code:
661 gfc_option.flag_d_lines = 1;
662 break;
663
664 case OPT_fd_lines_as_comments:
665 gfc_option.flag_d_lines = 0;
666 break;
667
668 case OPT_ffixed_form:
669 gfc_option.source_form = FORM_FIXED;
670 break;
671
672 case OPT_ffree_form:
673 gfc_option.source_form = FORM_FREE;
674 break;
675
676 case OPT_static_libgfortran:
677#ifndef HAVE_LD_STATIC_DYNAMIC1
678 gfc_fatal_error ("%<-static-libgfortran%> is not supported in this "
679 "configuration");
680#endif
681 break;
682
683 case OPT_fintrinsic_modules_path:
684 case OPT_fintrinsic_modules_path_:
685
686 /* This is needed because omp_lib.h is in a directory together
687 with intrinsic modules. Do no warn because during testing
688 without an installed compiler, we would get lots of bogus
689 warnings for a missing include directory. */
690 gfc_add_include_path (arg, false, false, false);
691
692 gfc_add_intrinsic_modules_path (arg);
693 break;
694
695 case OPT_fpreprocessed:
696 gfc_option.flag_preprocessed = value;
697 break;
698
699 case OPT_fmax_identifier_length_:
700 if (value > GFC_MAX_SYMBOL_LEN63)
701 gfc_fatal_error ("Maximum supported identifier length is %d",
702 GFC_MAX_SYMBOL_LEN63);
703 gfc_option.max_identifier_length = value;
704 break;
705
706 case OPT_finit_local_zero:
707 set_init_local_zero (value);
708 break;
709
710 case OPT_finit_logical_:
711 if (!strcasecmp (arg, "false"))
712 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
713 else if (!strcasecmp (arg, "true"))
714 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
715 else
716 gfc_fatal_error ("Unrecognized option to %<-finit-logical%>: %s",
717 arg);
718 break;
719
720 case OPT_finit_integer_:
721 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
722 gfc_option.flag_init_integer_value = strtol (arg, NULL__null, 10);
723 break;
724
725 case OPT_finit_character_:
726 if (value >= 0 && value <= 127)
727 {
728 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
729 gfc_option.flag_init_character_value = (char)value;
730 }
731 else
732 gfc_fatal_error ("The value of n in %<-finit-character=n%> must be "
733 "between 0 and 127");
734 break;
735
736 case OPT_I:
737 gfc_add_include_path (arg, true, false, true);
738 break;
739
740 case OPT_J:
741 gfc_handle_module_path_options (arg);
742 break;
743
744 case OPT_ffpe_trap_:
745 gfc_handle_fpe_option (arg, true);
746 break;
747
748 case OPT_ffpe_summary_:
749 gfc_handle_fpe_option (arg, false);
750 break;
751
752 case OPT_std_f95:
753 gfc_option.allow_std = GFC_STD_OPT_F95((1<<0) | (1<<3) | (1<<1) | (1<<8) | (
1<<10) | (1<<11))
;
754 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1);
755 gfc_option.max_continue_fixed = 19;
756 gfc_option.max_continue_free = 39;
757 gfc_option.max_identifier_length = 31;
758 warn_ampersandglobal_options.x_warn_ampersand = 1;
759 warn_tabsglobal_options.x_warn_tabs = 1;
760 break;
761
762 case OPT_std_f2003:
763 gfc_option.allow_std = GFC_STD_OPT_F03(((1<<0) | (1<<3) | (1<<1) | (1<<8) |
(1<<10) | (1<<11)) | (1<<4))
;
764 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1);
765 gfc_option.max_identifier_length = 63;
766 warn_ampersandglobal_options.x_warn_ampersand = 1;
767 warn_tabsglobal_options.x_warn_tabs = 1;
768 break;
769
770 case OPT_std_f2008:
771 gfc_option.allow_std = GFC_STD_OPT_F08((((1<<0) | (1<<3) | (1<<1) | (1<<8) |
(1<<10) | (1<<11)) | (1<<4)) | (1<<7
))
;
772 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1) | GFC_STD_F2008_OBS(1<<8);
773 gfc_option.max_identifier_length = 63;
774 warn_ampersandglobal_options.x_warn_ampersand = 1;
775 warn_tabsglobal_options.x_warn_tabs = 1;
776 break;
777
778 case OPT_std_f2008ts:
779 case OPT_std_f2018:
780 gfc_option.allow_std = GFC_STD_OPT_F18((((((1<<0) | (1<<3) | (1<<1) | (1<<8
) | (1<<10) | (1<<11)) | (1<<4)) | (1<<
7)) | (1<<9)) & (~(1<<11)))
;
781 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1) | GFC_STD_F2008_OBS(1<<8)
782 | GFC_STD_F2018_OBS(1<<10);
783 gfc_option.max_identifier_length = 63;
784 warn_ampersandglobal_options.x_warn_ampersand = 1;
785 warn_tabsglobal_options.x_warn_tabs = 1;
786 break;
787
788 case OPT_std_gnu:
789 set_default_std_flags ();
790 break;
791
792 case OPT_std_legacy:
793 set_default_std_flags ();
794 gfc_option.warn_std = 0;
795 break;
796
797 case OPT_fshort_enums:
798 /* Handled in language-independent code. */
799 break;
800
801 case OPT_fcheck_:
802 gfc_handle_runtime_check_option (arg);
803 break;
804
805 case OPT_fdec:
806 /* Set (or unset) the DEC extension flags. */
807 set_dec_flags (value);
808 break;
809 }
810
811 Fortran_handle_option_auto (&global_options, &global_options_set,
812 scode, arg, value,
813 gfc_option_lang_mask (), kind,
814 loc, handlers, global_dc);
815 return result;
816}
817
818
819/* Return a string with the options passed to the compiler; used for
820 Fortran's compiler_options() intrinsic. */
821
822char *
823gfc_get_option_string (void)
824{
825 unsigned j;
826 size_t len, pos;
827 char *result;
828
829 /* Allocate and return a one-character string with '\0'. */
830 if (!save_decoded_options_count)
831 return XCNEWVEC (char, 1)((char *) xcalloc ((1), sizeof (char)));
832
833 /* Determine required string length. */
834
835 len = 0;
836 for (j = 1; j < save_decoded_options_count; j++)
837 {
838 switch (save_decoded_options[j].opt_index)
839 {
840 case OPT_o:
841 case OPT_d:
842 case OPT_dumpbase:
843 case OPT_dumpbase_ext:
844 case OPT_dumpdir:
845 case OPT_quiet:
846 case OPT_version:
847 case OPT_fintrinsic_modules_path:
848 case OPT_fintrinsic_modules_path_:
849 /* Ignore these. */
850 break;
851 default:
852 /* Ignore file names. */
853 if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
854 len += 1
855 + strlen (save_decoded_options[j].orig_option_with_args_text);
856 }
857 }
858
859 result = XCNEWVEC (char, len)((char *) xcalloc ((len), sizeof (char)));
860
861 pos = 0;
862 for (j = 1; j < save_decoded_options_count; j++)
863 {
864 switch (save_decoded_options[j].opt_index)
865 {
866 case OPT_o:
867 case OPT_d:
868 case OPT_dumpbase:
869 case OPT_dumpbase_ext:
870 case OPT_dumpdir:
871 case OPT_quiet:
872 case OPT_version:
873 case OPT_fintrinsic_modules_path:
874 case OPT_fintrinsic_modules_path_:
875 /* Ignore these. */
876 continue;
877
878 case OPT_cpp_:
879 /* Use "-cpp" rather than "-cpp=<temporary file>". */
880 len = 4;
881 break;
882
883 default:
884 /* Ignore file names. */
885 if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
886 continue;
887
888 len = strlen (save_decoded_options[j].orig_option_with_args_text);
889 }
890
891 memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
892 pos += len;
893 result[pos++] = ' ';
894 }
895
896 result[--pos] = '\0';
897 return result;
898}
899
900#undef SET_BITFLAG
901#undef SET_BITFLAG2
902#undef SET_FLAG