Bug Summary

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

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name options.cc -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 -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/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 -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-0h1RR_.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/options.cc
1/* Parse and display command line options.
2 Copyright (C) 2000-2023 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 << 6);
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 set_dec_flags (0);
163 set_default_std_flags ();
164
165 /* Initialize cpp-related options. */
166 gfc_cpp_init_options (decoded_options_count, decoded_options);
167 gfc_diagnostics_init ();
168}
169
170
171/* Determine the source form from the filename extension. We assume
172 case insensitivity. */
173
174static gfc_source_form
175form_from_filename (const char *filename)
176{
177 static const struct
178 {
179 const char *extension;
180 gfc_source_form form;
181 }
182 exttype[] =
183 {
184 {
185 ".f90", FORM_FREE}
186 ,
187 {
188 ".f95", FORM_FREE}
189 ,
190 {
191 ".f03", FORM_FREE}
192 ,
193 {
194 ".f08", FORM_FREE}
195 ,
196 {
197 ".f", FORM_FIXED}
198 ,
199 {
200 ".for", FORM_FIXED}
201 ,
202 {
203 ".ftn", FORM_FIXED}
204 ,
205 {
206 "", FORM_UNKNOWN}
207 }; /* sentinel value */
208
209 gfc_source_form f_form;
210 const char *fileext;
211 int i;
212
213 /* Find end of file name. Note, filename is either a NULL pointer or
214 a NUL terminated string. */
215 i = 0;
216 while (filename[i] != '\0')
217 i++;
218
219 /* Find last period. */
220 while (i >= 0 && (filename[i] != '.'))
221 i--;
222
223 /* Did we see a file extension? */
224 if (i < 0)
225 return FORM_UNKNOWN; /* Nope */
226
227 /* Get file extension and compare it to others. */
228 fileext = &(filename[i]);
229
230 i = -1;
231 f_form = FORM_UNKNOWN;
232 do
233 {
234 i++;
235 if (strcasecmp (fileext, exttype[i].extension) == 0)
236 {
237 f_form = exttype[i].form;
238 break;
239 }
240 }
241 while (exttype[i].form != FORM_UNKNOWN);
242
243 return f_form;
244}
245
246
247/* Finalize commandline options. */
248
249bool
250gfc_post_options (const char **pfilename)
251{
252 const char *filename = *pfilename, *canon_source_file = NULL__null;
253 char *source_path;
254 bool verbose_missing_dir_warn;
255 int i;
256
257 /* This needs to be after the commandline has been processed.
258 In Fortran, the options is by default enabled, in C/C++
259 by default disabled.
260 If not enabled explicitly by the user, only warn for -I
261 and -J, otherwise warn for all include paths. */
262 verbose_missing_dir_warn
263 = (OPTION_SET_P (cpp_warn_missing_include_dirs)global_options_set.x_cpp_warn_missing_include_dirs
1
Assuming field 'x_cpp_warn_missing_include_dirs' is 0
→
264 && global_options.x_cpp_warn_missing_include_dirs);
265 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)
2
←
Taking true branch
→
3
←
Loop condition is false. Exiting loop
→
266 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);
267 gfc_check_include_dirs (verbose_missing_dir_warn);
268
269 /* Finalize DEC flags. */
270 post_dec_flags (flag_decglobal_options.x_flag_dec);
271
272 /* Excess precision other than "fast" requires front-end
273 support. */
274 if (flag_excess_precisionglobal_options.x_flag_excess_precision == EXCESS_PRECISION_STANDARD)
4
←
Assuming field 'x_flag_excess_precision' is not equal to EXCESS_PRECISION_STANDARD
→
5
←
Taking false branch
→
275 sorry ("%<-fexcess-precision=standard%> for Fortran");
276 else if (flag_excess_precisionglobal_options.x_flag_excess_precision == EXCESS_PRECISION_FLOAT16)
6
←
Assuming field 'x_flag_excess_precision' is not equal to EXCESS_PRECISION_FLOAT16
→
7
←
Taking false branch
→
277 sorry ("%<-fexcess-precision=16%> for Fortran");
278
279 flag_excess_precisionglobal_options.x_flag_excess_precision = EXCESS_PRECISION_FAST;
280
281 /* Fortran allows associative math - but we cannot reassociate if
282 we want traps or signed zeros. Cf. also flag_protect_parens. */
283 if (flag_associative_mathglobal_options.x_flag_associative_math == -1)
8
←
Assuming the condition is false
→
9
←
Taking false branch
→
284 flag_associative_mathglobal_options.x_flag_associative_math = (!flag_trapping_mathglobal_options.x_flag_trapping_math && !flag_signed_zerosglobal_options.x_flag_signed_zeros);
285
286 if (flag_protect_parensglobal_options.x_flag_protect_parens == -1)
10
←
Assuming the condition is false
→
287 flag_protect_parensglobal_options.x_flag_protect_parens = !optimize_fastglobal_options.x_optimize_fast;
288
289 /* -Ofast sets implies -fstack-arrays unless an explicit size is set for
290 stack arrays. */
291 if (flag_stack_arraysglobal_options.x_flag_stack_arrays == -1 && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2)
11
←
Assuming the condition is false
→
292 flag_stack_arraysglobal_options.x_flag_stack_arrays = optimize_fastglobal_options.x_optimize_fast;
293
294 /* By default, disable (re)allocation during assignment for -std=f95,
295 and enable it for F2003/F2008/GNU/Legacy. */
296 if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs == -1)
12
←
Assuming the condition is false
→
13
←
Taking false branch
→
297 {
298 if (gfc_option.allow_std & GFC_STD_F2003(1<<4))
299 flag_realloc_lhsglobal_options.x_flag_realloc_lhs = 1;
300 else
301 flag_realloc_lhsglobal_options.x_flag_realloc_lhs = 0;
302 }
303
304 /* -fbounds-check is equivalent to -fcheck=bounds */
305 if (flag_bounds_checkglobal_options.x_flag_bounds_check)
14
←
Assuming field 'x_flag_bounds_check' is 0
→
15
←
Taking false branch
→
306 gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS(1<<0);
307
308 if (flag_compare_debugglobal_options.x_flag_compare_debug)
16
←
Assuming field 'x_flag_compare_debug' is 0
→
17
←
Taking false branch
→
309 flag_dump_fortran_originalglobal_options.x_flag_dump_fortran_original = 0;
310
311 /* Make -fmax-errors visible to gfortran's diagnostic machinery. */
312 if (OPTION_SET_P (flag_max_errors)global_options_set.x_flag_max_errors)
18
←
Assuming field 'x_flag_max_errors' is 0
→
313 gfc_option.max_errors = flag_max_errorsglobal_options.x_flag_max_errors;
314
315 /* Verify the input file name. */
316 if (!filename || strcmp (filename, "-") == 0)
19
←
Assuming 'filename' is non-null
→
20
←
Assuming the condition is false
→
21
←
Taking false branch
→
317 {
318 filename = "";
319 }
320
321 if (gfc_option.flag_preprocessed)
22
←
Assuming field 'flag_preprocessed' is 0
→
23
←
Taking false branch
→
322 {
323 /* For preprocessed files, if the first tokens are of the form # NUM.
324 handle the directives so we know the original file name. */
325 gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
326 if (gfc_source_file == NULL__null)
327 gfc_source_file = filename;
328 else
329 *pfilename = gfc_source_file;
330 }
331 else
332 gfc_source_file = filename;
333
334 if (canon_source_file
23.1
'canon_source_file' is equal to NULL
 == NULL__null)
24
←
Taking true branch
→
335 canon_source_file = gfc_source_file;
336
337 /* Adds the path where the source file is to the list of include files. */
338
339 i = strlen (canon_source_file);
340 while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i])(((canon_source_file[i]) == '/') || (((canon_source_file[i]) ==
'\\') && (0))))
25
←
Assuming 'i' is <= 0
→
341 i--;
342
343 if (i
25.1
'i' is equal to 0
 != 0)
26
←
Taking false branch
→
344 {
345 source_path = (char *) alloca (i + 1)__builtin_alloca(i + 1);
346 memcpy (source_path, canon_source_file, i);
347 source_path[i] = 0;
348 /* Only warn if the directory is different from the input file as
349 if that one is not found, already an error is shown. */
350 bool warn = gfc_option.flag_preprocessed && gfc_source_file != filename;
351 gfc_add_include_path (source_path, true, true, warn, false);
352 }
353 else
354 gfc_add_include_path (".", true, true, false, false);
355
356 if (canon_source_file != gfc_source_file)
27
←
Assuming 'canon_source_file' is not equal to 'gfc_source_file'
→
28
←
Taking true branch
→
357 free (CONST_CAST (char *, canon_source_file)(const_cast<char *> ((canon_source_file))));
29
←
Memory is released
→
358
359 /* Decide which form the file will be read in as. */
360
361 if (gfc_option.source_form != FORM_UNKNOWN)
30
←
Assuming field 'source_form' is equal to FORM_UNKNOWN
→
31
←
Taking false branch
→
362 gfc_current_form = gfc_option.source_form;
363 else
364 {
365 gfc_current_form = form_from_filename (filename);
32
←
Use of memory after it is freed
366
367 if (gfc_current_form == FORM_UNKNOWN)
368 {
369 gfc_current_form = FORM_FREE;
370 main_input_filenameglobal_options.x_main_input_filename = filename;
371 gfc_warning_now (0, "Reading file %qs as free form",
372 (filename[0] == '\0') ? "<stdin>" : filename);
373 }
374 }
375
376 /* If the user specified -fd-lines-as-{code|comments} verify that we're
377 in fixed form. */
378 if (gfc_current_form == FORM_FREE)
379 {
380 if (gfc_option.flag_d_lines == 0)
381 gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect "
382 "in free form");
383 else if (gfc_option.flag_d_lines == 1)
384 gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form");
385
386 if (warn_line_truncationglobal_options.x_warn_line_truncation == -1)
387 warn_line_truncationglobal_options.x_warn_line_truncation = 1;
388
389 /* Enable -Werror=line-truncation when -Werror and -Wno-error have
390 not been set. */
391 if (warn_line_truncationglobal_options.x_warn_line_truncation && !OPTION_SET_P (warnings_are_errors)global_options_set.x_warnings_are_errors
392 && (global_dc->classify_diagnostic[OPT_Wline_truncation] ==
393 DK_UNSPECIFIED))
394 diagnostic_classify_diagnostic (global_dc, OPT_Wline_truncation,
395 DK_ERROR, UNKNOWN_LOCATION((location_t) 0));
396 }
397 else
398 {
399 /* With -fdec, set -fd-lines-as-comments by default in fixed form. */
400 if (flag_decglobal_options.x_flag_dec && gfc_option.flag_d_lines == -1)
401 gfc_option.flag_d_lines = 0;
402
403 if (warn_line_truncationglobal_options.x_warn_line_truncation == -1)
404 warn_line_truncationglobal_options.x_warn_line_truncation = 0;
405 }
406
407 /* If -pedantic, warn about the use of GNU extensions. */
408 if (pedanticglobal_options.x_pedantic && (gfc_option.allow_std & GFC_STD_GNU(1<<5)) != 0)
409 gfc_option.warn_std |= GFC_STD_GNU(1<<5);
410 /* -std=legacy -pedantic is effectively -std=gnu. */
411 if (pedanticglobal_options.x_pedantic && (gfc_option.allow_std & GFC_STD_LEGACY(1<<6)) != 0)
412 gfc_option.warn_std |= GFC_STD_F95_OBS(1<<1) | GFC_STD_F95_DEL(1<<2) | GFC_STD_LEGACY(1<<6);
413
414 /* If the user didn't explicitly specify -f(no)-second-underscore we
415 use it if we're trying to be compatible with f2c, and not
416 otherwise. */
417 if (flag_second_underscoreglobal_options.x_flag_second_underscore == -1)
418 flag_second_underscoreglobal_options.x_flag_second_underscore = flag_f2cglobal_options.x_flag_f2c;
419
420 if (!flag_automaticglobal_options.x_flag_automatic && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != -2
421 && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != 0)
422 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
423 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size);
424 else if (!flag_automaticglobal_options.x_flag_automatic && flag_recursiveglobal_options.x_flag_recursive)
425 gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
426 "overwrites %<-frecursive%>");
427 else if (!flag_automaticglobal_options.x_flag_automatic && (flag_openmpglobal_options.x_flag_openmp || flag_openaccglobal_options.x_flag_openacc))
428 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> "
429 "implied by %qs", flag_openmpglobal_options.x_flag_openmp ? "-fopenmp" : "-fopenacc");
430 else if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != -2 && flag_recursiveglobal_options.x_flag_recursive)
431 gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
432 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size);
433 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))
434 gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites "
435 "%<-frecursive%> implied by %qs", flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size,
436 flag_openmpglobal_options.x_flag_openmp ? "-fopenmp" : "-fopenacc");
437
438 /* Implement -frecursive as -fmax-stack-var-size=-1. */
439 if (flag_recursiveglobal_options.x_flag_recursive)
440 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = -1;
441
442 /* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
443 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2 && flag_automaticglobal_options.x_flag_automatic
444 && (flag_openmpglobal_options.x_flag_openmp || flag_openaccglobal_options.x_flag_openacc))
445 {
446 flag_recursiveglobal_options.x_flag_recursive = 1;
447 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = -1;
448 }
449
450 /* Set flag_stack_arrays correctly. */
451 if (flag_stack_arraysglobal_options.x_flag_stack_arrays == -1)
452 flag_stack_arraysglobal_options.x_flag_stack_arrays = 0;
453
454 /* Set default. */
455 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == -2)
456 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = 65536;
457
458 /* Implement -fno-automatic as -fmax-stack-var-size=0. */
459 if (!flag_automaticglobal_options.x_flag_automatic)
460 flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size = 0;
461
462 /* If the user did not specify an inline matmul limit, inline up to the BLAS
463 limit or up to 30 if no external BLAS is specified. */
464
465 if (flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit < 0)
466 {
467 if (flag_external_blasglobal_options.x_flag_external_blas)
468 flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit = flag_blas_matmul_limitglobal_options.x_flag_blas_matmul_limit;
469 else
470 flag_inline_matmul_limitglobal_options.x_flag_inline_matmul_limit = 30;
471 }
472
473 /* Optimization implies front end optimization, unless the user
474 specified it directly. */
475
476 if (flag_frontend_optimizeglobal_options.x_flag_frontend_optimize == -1)
477 flag_frontend_optimizeglobal_options.x_flag_frontend_optimize = optimizeglobal_options.x_optimize && !optimize_debugglobal_options.x_optimize_debug;
478
479 /* Same for front end loop interchange. */
480
481 if (flag_frontend_loop_interchangeglobal_options.x_flag_frontend_loop_interchange == -1)
482 flag_frontend_loop_interchangeglobal_options.x_flag_frontend_loop_interchange = optimizeglobal_options.x_optimize;
483
484 /* Do inline packing by default if optimizing, but not if
485 optimizing for size. */
486 if (flag_inline_arg_packingglobal_options.x_flag_inline_arg_packing == -1)
487 flag_inline_arg_packingglobal_options.x_flag_inline_arg_packing = optimizeglobal_options.x_optimize && !optimize_sizeglobal_options.x_optimize_size;
488
489 if (flag_max_array_constructorglobal_options.x_flag_max_array_constructor < 65535)
490 flag_max_array_constructorglobal_options.x_flag_max_array_constructor = 65535;
491
492 if (flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length != 0 && flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length < 7)
493 gfc_fatal_error ("Fixed line length must be at least seven");
494
495 if (flag_free_line_lengthglobal_options.x_flag_free_line_length != 0 && flag_free_line_lengthglobal_options.x_flag_free_line_length < 4)
496 gfc_fatal_error ("Free line length must be at least three");
497
498 if (flag_max_subrecord_lengthglobal_options.x_flag_max_subrecord_length > MAX_SUBRECORD_LENGTH2147483639)
499 gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
500 MAX_SUBRECORD_LENGTH2147483639);
501
502 gfc_cpp_post_options (verbose_missing_dir_warn);
503
504 if (gfc_option.allow_std & GFC_STD_F2008(1<<7))
505 lang_hooks.name = "GNU Fortran2008";
506 else if (gfc_option.allow_std & GFC_STD_F2003(1<<4))
507 lang_hooks.name = "GNU Fortran2003";
508
509 return gfc_cpp_preprocess_only ();
510}
511
512
513static void
514gfc_handle_module_path_options (const char *arg)
515{
516
517 if (gfc_option.module_dir != NULL__null)
518 gfc_fatal_error ("gfortran: Only one %<-J%> option allowed");
519
520 gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2)((char *) xcalloc ((strlen (arg) + 2), sizeof (char)));
521 strcpy (gfc_option.module_dir, arg);
522
523 gfc_add_include_path (gfc_option.module_dir, true, false, true, true);
524
525 strcat (gfc_option.module_dir, "/");
526}
527
528
529/* Handle options -ffpe-trap= and -ffpe-summary=. */
530
531static void
532gfc_handle_fpe_option (const char *arg, bool trap)
533{
534 int result, pos = 0, n;
535 /* precision is a backwards compatibility alias for inexact. */
536 static const char * const exception[] = { "invalid", "denormal", "zero",
537 "overflow", "underflow",
538 "inexact", "precision", NULL__null };
539 static const int opt_exception[] = { GFC_FPE_INVALID1, GFC_FPE_DENORMAL2,
540 GFC_FPE_ZERO4, GFC_FPE_OVERFLOW8,
541 GFC_FPE_UNDERFLOW16, GFC_FPE_INEXACT32,
542 GFC_FPE_INEXACT32,
543 0 };
544
545 /* As the default for -ffpe-summary= is nonzero, set it to 0. */
546 if (!trap)
547 gfc_option.fpe_summary = 0;
548
549 while (*arg)
550 {
551 while (*arg == ',')
552 arg++;
553
554 while (arg[pos] && arg[pos] != ',')
555 pos++;
556
557 result = 0;
558 if (!trap && strncmp ("none", arg, pos) == 0)
559 {
560 gfc_option.fpe_summary = 0;
561 arg += pos;
562 pos = 0;
563 continue;
564 }
565 else if (!trap && strncmp ("all", arg, pos) == 0)
566 {
567 gfc_option.fpe_summary = GFC_FPE_INVALID1 | GFC_FPE_DENORMAL2
568 | GFC_FPE_ZERO4 | GFC_FPE_OVERFLOW8
569 | GFC_FPE_UNDERFLOW16 | GFC_FPE_INEXACT32;
570 arg += pos;
571 pos = 0;
572 continue;
573 }
574 else
575 for (n = 0; exception[n] != NULL__null; n++)
576 {
577 if (exception[n] && strncmp (exception[n], arg, pos) == 0)
578 {
579 if (trap)
580 gfc_option.fpe |= opt_exception[n];
581 else
582 gfc_option.fpe_summary |= opt_exception[n];
583 arg += pos;
584 pos = 0;
585 result = 1;
586 break;
587 }
588 }
589 if (!result && !trap)
590 gfc_fatal_error ("Argument to %<-ffpe-trap%> is not valid: %s", arg);
591 else if (!result)
592 gfc_fatal_error ("Argument to %<-ffpe-summary%> is not valid: %s", arg);
593
594 }
595}
596
597
598static void
599gfc_handle_runtime_check_option (const char *arg)
600{
601 int result, pos = 0, n;
602 static const char * const optname[] = { "all", "bounds", "array-temps",
603 "recursion", "do", "pointer",
604 "mem", "bits", NULL__null };
605 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),
606 GFC_RTCHECK_ARRAY_TEMPS(1<<1),
607 GFC_RTCHECK_RECURSION(1<<2), GFC_RTCHECK_DO(1<<3),
608 GFC_RTCHECK_POINTER(1<<4), GFC_RTCHECK_MEM(1<<5),
609 GFC_RTCHECK_BITS(1<<6), 0 };
610
611 while (*arg)
612 {
613 while (*arg == ',')
614 arg++;
615
616 while (arg[pos] && arg[pos] != ',')
617 pos++;
618
619 result = 0;
620 for (n = 0; optname[n] != NULL__null; n++)
621 {
622 if (optname[n] && strncmp (optname[n], arg, pos) == 0)
623 {
624 gfc_option.rtcheck |= optmask[n];
625 arg += pos;
626 pos = 0;
627 result = 1;
628 break;
629 }
630 else if (optname[n] && pos > 3 && startswith (arg, "no-")
631 && strncmp (optname[n], arg+3, pos-3) == 0)
632 {
633 gfc_option.rtcheck &= ~optmask[n];
634 arg += pos;
635 pos = 0;
636 result = 1;
637 break;
638 }
639 }
640 if (!result)
641 gfc_fatal_error ("Argument to %<-fcheck%> is not valid: %s", arg);
642 }
643}
644
645
646/* Handle command-line options. Returns 0 if unrecognized, 1 if
647 recognized and handled. */
648
649bool
650gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INTlong value,
651 int kind ATTRIBUTE_UNUSED__attribute__ ((__unused__)), location_t loc ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
652 const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
653{
654 bool result = true;
655 enum opt_code code = (enum opt_code) scode;
656
657 if (gfc_cpp_handle_option (scode, arg, value) == 1)
658 return true;
659
660 switch (code)
661 {
662 default:
663 if (cl_options[code].flags & gfc_option_lang_mask ())
664 break;
665 result = false;
666 break;
667
668 case OPT_fcheck_array_temporaries:
669 SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS(1<<1));
670 break;
671
672 case OPT_fd_lines_as_code:
673 gfc_option.flag_d_lines = 1;
674 break;
675
676 case OPT_fd_lines_as_comments:
677 gfc_option.flag_d_lines = 0;
678 break;
679
680 case OPT_ffixed_form:
681 gfc_option.source_form = FORM_FIXED;
682 break;
683
684 case OPT_ffree_form:
685 gfc_option.source_form = FORM_FREE;
686 break;
687
688 case OPT_fintrinsic_modules_path:
689 case OPT_fintrinsic_modules_path_:
690
691 /* This is needed because omp_lib.h is in a directory together
692 with intrinsic modules. Do no warn because during testing
693 without an installed compiler, we would get lots of bogus
694 warnings for a missing include directory. */
695 gfc_add_include_path (arg, false, false, false, true);
696
697 gfc_add_intrinsic_modules_path (arg);
698 break;
699
700 case OPT_fpreprocessed:
701 gfc_option.flag_preprocessed = value;
702 break;
703
704 case OPT_fmax_identifier_length_:
705 if (value > GFC_MAX_SYMBOL_LEN63)
706 gfc_fatal_error ("Maximum supported identifier length is %d",
707 GFC_MAX_SYMBOL_LEN63);
708 gfc_option.max_identifier_length = value;
709 break;
710
711 case OPT_finit_local_zero:
712 set_init_local_zero (value);
713 break;
714
715 case OPT_finit_logical_:
716 if (!strcasecmp (arg, "false"))
717 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
718 else if (!strcasecmp (arg, "true"))
719 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
720 else
721 gfc_fatal_error ("Unrecognized option to %<-finit-logical%>: %s",
722 arg);
723 break;
724
725 case OPT_finit_integer_:
726 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
727 gfc_option.flag_init_integer_value = strtol (arg, NULL__null, 10);
728 break;
729
730 case OPT_finit_character_:
731 if (value >= 0 && value <= 127)
732 {
733 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
734 gfc_option.flag_init_character_value = (char)value;
735 }
736 else
737 gfc_fatal_error ("The value of n in %<-finit-character=n%> must be "
738 "between 0 and 127");
739 break;
740
741 case OPT_I:
742 gfc_add_include_path (arg, true, false, true, true);
743 break;
744
745 case OPT_J:
746 gfc_handle_module_path_options (arg);
747 break;
748
749 case OPT_ffpe_trap_:
750 gfc_handle_fpe_option (arg, true);
751 break;
752
753 case OPT_ffpe_summary_:
754 gfc_handle_fpe_option (arg, false);
755 break;
756
757 case OPT_std_f95:
758 gfc_option.allow_std = GFC_STD_OPT_F95((1<<0) | (1<<3) | (1<<1) | (1<<8) | (
1<<10) | (1<<11));
759 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1);
760 gfc_option.max_continue_fixed = 19;
761 gfc_option.max_continue_free = 39;
762 gfc_option.max_identifier_length = 31;
763 warn_ampersandglobal_options.x_warn_ampersand = 1;
764 warn_tabsglobal_options.x_warn_tabs = 1;
765 break;
766
767 case OPT_std_f2003:
768 gfc_option.allow_std = GFC_STD_OPT_F03(((1<<0) | (1<<3) | (1<<1) | (1<<8) |
(1<<10) | (1<<11)) | (1<<4));
769 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1);
770 gfc_option.max_identifier_length = 63;
771 warn_ampersandglobal_options.x_warn_ampersand = 1;
772 warn_tabsglobal_options.x_warn_tabs = 1;
773 break;
774
775 case OPT_std_f2008:
776 gfc_option.allow_std = GFC_STD_OPT_F08((((1<<0) | (1<<3) | (1<<1) | (1<<8) |
(1<<10) | (1<<11)) | (1<<4)) | (1<<7
));
777 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1) | GFC_STD_F2008_OBS(1<<8);
778 gfc_option.max_identifier_length = 63;
779 warn_ampersandglobal_options.x_warn_ampersand = 1;
780 warn_tabsglobal_options.x_warn_tabs = 1;
781 break;
782
783 case OPT_std_f2008ts:
784 case OPT_std_f2018:
785 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)));
786 gfc_option.warn_std = GFC_STD_F95_OBS(1<<1) | GFC_STD_F2008_OBS(1<<8)
787 | GFC_STD_F2018_OBS(1<<10);
788 gfc_option.max_identifier_length = 63;
789 warn_ampersandglobal_options.x_warn_ampersand = 1;
790 warn_tabsglobal_options.x_warn_tabs = 1;
791 break;
792
793 case OPT_std_gnu:
794 set_default_std_flags ();
795 break;
796
797 case OPT_std_legacy:
798 set_default_std_flags ();
799 gfc_option.warn_std = 0;
800 break;
801
802 case OPT_fshort_enums:
803 /* Handled in language-independent code. */
804 break;
805
806 case OPT_fcheck_:
807 gfc_handle_runtime_check_option (arg);
808 break;
809
810 case OPT_fdec:
811 /* Set (or unset) the DEC extension flags. */
812 set_dec_flags (value);
813 break;
814 }
815
816 Fortran_handle_option_auto (&global_options, &global_options_set,
817 scode, arg, value,
818 gfc_option_lang_mask (), kind,
819 loc, handlers, global_dc);
820 return result;
821}
822
823
824/* Return a string with the options passed to the compiler; used for
825 Fortran's compiler_options() intrinsic. */
826
827char *
828gfc_get_option_string (void)
829{
830 unsigned j;
831 size_t len, pos;
832 char *result;
833
834 /* Allocate and return a one-character string with '\0'. */
835 if (!save_decoded_options_count)
836 return XCNEWVEC (char, 1)((char *) xcalloc ((1), sizeof (char)));
837
838 /* Determine required string length. */
839
840 len = 0;
841 for (j = 1; j < save_decoded_options_count; j++)
842 {
843 switch (save_decoded_options[j].opt_index)
844 {
845 case OPT_o:
846 case OPT_d:
847 case OPT_dumpbase:
848 case OPT_dumpbase_ext:
849 case OPT_dumpdir:
850 case OPT_quiet:
851 case OPT_version:
852 case OPT_fintrinsic_modules_path:
853 case OPT_fintrinsic_modules_path_:
854 /* Ignore these. */
855 break;
856 default:
857 /* Ignore file names. */
858 if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
859 len += 1
860 + strlen (save_decoded_options[j].orig_option_with_args_text);
861 }
862 }
863
864 result = XCNEWVEC (char, len)((char *) xcalloc ((len), sizeof (char)));
865
866 pos = 0;
867 for (j = 1; j < save_decoded_options_count; j++)
868 {
869 switch (save_decoded_options[j].opt_index)
870 {
871 case OPT_o:
872 case OPT_d:
873 case OPT_dumpbase:
874 case OPT_dumpbase_ext:
875 case OPT_dumpdir:
876 case OPT_quiet:
877 case OPT_version:
878 case OPT_fintrinsic_modules_path:
879 case OPT_fintrinsic_modules_path_:
880 /* Ignore these. */
881 continue;
882
883 case OPT_cpp_:
884 /* Use "-cpp" rather than "-cpp=<temporary file>". */
885 len = 4;
886 break;
887
888 default:
889 /* Ignore file names. */
890 if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
891 continue;
892
893 len = strlen (save_decoded_options[j].orig_option_with_args_text);
894 }
895
896 memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
897 pos += len;
898 result[pos++] = ' ';
899 }
900
901 result[--pos] = '\0';
902 return result;
903}
904
905#undef SET_BITFLAG
906#undef SET_BITFLAG2
907#undef SET_FLAG