gcc/fortran/options.c

   1 /* Parse and display command line options.
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   3    2009, 2010, 2011, 2012
   4    Free Software Foundation, Inc.
   5    Contributed by Andy Vaught
   6
   7 This file is part of GCC.
   8
   9 GCC is free software; you can redistribute it and/or modify it under
  10 the terms of the GNU General Public License as published by the Free
  11 Software Foundation; either version 3, or (at your option) any later
  12 version.
  13
  14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with GCC; see the file COPYING3.  If not see
  21 <http://www.gnu.org/licenses/>.  */
  22
  23 #include "config.h"
  24 #include "system.h"
  25 #include "coretypes.h"
  26 #include "tree.h"
  27 #include "flags.h"
  28 #include "intl.h"
  29 #include "opts.h"
  30 #include "toplev.h"  /* For save_decoded_options.  */
  31 #include "options.h"
  32 #include "params.h"
  33 #include "tree-inline.h"
  34 #include "gfortran.h"
  35 #include "target.h"
  36 #include "cpp.h"
  37 #include "diagnostic.h" /* For global_dc.  */
  38 #include "tm.h"
  39
  40 gfc_option_t gfc_option;
  41
  42
  43 /* Set flags that control warnings and errors for different
  44    Fortran standards to their default values.  Keep in sync with
  45    libgfortran/runtime/compile_options.c (init_compile_options).  */
  46
  47 static void
  48 set_default_std_flags (void)
  49 {
  50   gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
  51     | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
  52     | GFC_STD_F2008_OBS | GFC_STD_F2008_TS | GFC_STD_GNU | GFC_STD_LEGACY;
  53   gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
  54 }
  55
  56
  57 /* Return language mask for Fortran options.  */
  58
  59 unsigned int
  60 gfc_option_lang_mask (void)
  61 {
  62   return CL_Fortran;
  63 }
  64
  65 /* Initialize options structure OPTS.  */
  66
  67 void
  68 gfc_init_options_struct (struct gcc_options *opts)
  69 {
  70   opts->x_flag_errno_math = 0;
  71   opts->x_flag_associative_math = -1;
  72 }
  73
  74 /* Get ready for options handling. Keep in sync with
  75    libgfortran/runtime/compile_options.c (init_compile_options). */
  76
  77 void
  78 gfc_init_options (unsigned int decoded_options_count,
  79                   struct cl_decoded_option *decoded_options)
  80 {
  81   gfc_source_file = NULL;
  82   gfc_option.module_dir = NULL;
  83   gfc_option.source_form = FORM_UNKNOWN;
  84   gfc_option.fixed_line_length = 72;
  85   gfc_option.free_line_length = 132;
  86   gfc_option.max_continue_fixed = 255;
  87   gfc_option.max_continue_free = 255;
  88   gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
  89   gfc_option.max_subrecord_length = 0;
  90   gfc_option.flag_max_array_constructor = 65535;
  91   gfc_option.convert = GFC_CONVERT_NATIVE;
  92   gfc_option.record_marker = 0;
  93   gfc_option.dump_fortran_original = 0;
  94   gfc_option.dump_fortran_optimized = 0;
  95
  96   gfc_option.warn_aliasing = 0;
  97   gfc_option.warn_ampersand = 0;
  98   gfc_option.warn_character_truncation = 0;
  99   gfc_option.warn_array_temp = 0;
 100   gfc_option.warn_c_binding_type = 0;
 101   gfc_option.gfc_warn_conversion = 0;
 102   gfc_option.warn_conversion_extra = 0;
 103   gfc_option.warn_function_elimination = 0;
 104   gfc_option.warn_implicit_interface = 0;
 105   gfc_option.warn_line_truncation = 0;
 106   gfc_option.warn_surprising = 0;
 107   gfc_option.warn_tabs = 1;
 108   gfc_option.warn_underflow = 1;
 109   gfc_option.warn_intrinsic_shadow = 0;
 110   gfc_option.warn_intrinsics_std = 0;
 111   gfc_option.warn_align_commons = 1;
 112   gfc_option.warn_real_q_constant = 0;
 113   gfc_option.warn_unused_dummy_argument = 0;
 114   gfc_option.warn_realloc_lhs = 0;
 115   gfc_option.warn_realloc_lhs_all = 0;
 116   gfc_option.warn_compare_reals = 0;
 117   gfc_option.warn_target_lifetime = 0;
 118   gfc_option.max_errors = 25;
 119
 120   gfc_option.flag_all_intrinsics = 0;
 121   gfc_option.flag_default_double = 0;
 122   gfc_option.flag_default_integer = 0;
 123   gfc_option.flag_default_real = 0;
 124   gfc_option.flag_integer4_kind = 0;
 125   gfc_option.flag_real4_kind = 0;
 126   gfc_option.flag_real8_kind = 0;
 127   gfc_option.flag_dollar_ok = 0;
 128   gfc_option.flag_underscoring = 1;
 129   gfc_option.flag_whole_file = 1;
 130   gfc_option.flag_f2c = 0;
 131   gfc_option.flag_second_underscore = -1;
 132   gfc_option.flag_implicit_none = 0;
 133
 134   /* Default value of flag_max_stack_var_size is set in gfc_post_options.  */
 135   gfc_option.flag_max_stack_var_size = -2;
 136   gfc_option.flag_stack_arrays = -1;
 137
 138   gfc_option.flag_range_check = 1;
 139   gfc_option.flag_pack_derived = 0;
 140   gfc_option.flag_repack_arrays = 0;
 141   gfc_option.flag_preprocessed = 0;
 142   gfc_option.flag_automatic = 1;
 143   gfc_option.flag_backslash = 0;
 144   gfc_option.flag_module_private = 0;
 145   gfc_option.flag_backtrace = 1;
 146   gfc_option.flag_allow_leading_underscore = 0;
 147   gfc_option.flag_external_blas = 0;
 148   gfc_option.blas_matmul_limit = 30;
 149   gfc_option.flag_cray_pointer = 0;
 150   gfc_option.flag_d_lines = -1;
 151   gfc_option.gfc_flag_openmp = 0;
 152   gfc_option.flag_sign_zero = 1;
 153   gfc_option.flag_recursive = 0;
 154   gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
 155   gfc_option.flag_init_integer_value = 0;
 156   gfc_option.flag_init_real = GFC_INIT_REAL_OFF;
 157   gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
 158   gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
 159   gfc_option.flag_init_character_value = (char)0;
 160   gfc_option.flag_align_commons = 1;
 161   gfc_option.flag_protect_parens = -1;
 162   gfc_option.flag_realloc_lhs = -1;
 163   gfc_option.flag_aggressive_function_elimination = 0;
 164   gfc_option.flag_frontend_optimize = -1;
 165
 166   gfc_option.fpe = 0;
 167   gfc_option.rtcheck = 0;
 168   gfc_option.coarray = GFC_FCOARRAY_NONE;
 169
 170   set_default_std_flags ();
 171
 172   /* Initialize cpp-related options.  */
 173   gfc_cpp_init_options (decoded_options_count, decoded_options);
 174 }
 175
 176
 177 /* Determine the source form from the filename extension.  We assume
 178    case insensitivity.  */
 179
 180 static gfc_source_form
 181 form_from_filename (const char *filename)
 182 {
 183   static const struct
 184   {
 185     const char *extension;
 186     gfc_source_form form;
 187   }
 188   exttype[] =
 189   {
 190     {
 191     ".f90", FORM_FREE}
 192     ,
 193     {
 194     ".f95", FORM_FREE}
 195     ,
 196     {
 197     ".f03", FORM_FREE}
 198     ,
 199     {
 200     ".f08", FORM_FREE}
 201     ,
 202     {
 203     ".f", FORM_FIXED}
 204     ,
 205     {
 206     ".for", FORM_FIXED}
 207     ,
 208     {
 209     ".ftn", FORM_FIXED}
 210     ,
 211     {
 212     "", FORM_UNKNOWN}
 213   };            /* sentinel value */
 214
 215   gfc_source_form f_form;
 216   const char *fileext;
 217   int i;
 218
 219   /* Find end of file name.  Note, filename is either a NULL pointer or
 220      a NUL terminated string.  */
 221   i = 0;
 222   while (filename[i] != '\0')
 223     i++;
 224
 225   /* Find last period.  */
 226   while (i >= 0 && (filename[i] != '.'))
 227     i--;
 228
 229   /* Did we see a file extension?  */
 230   if (i < 0)
 231     return FORM_UNKNOWN; /* Nope  */
 232
 233   /* Get file extension and compare it to others.  */
 234   fileext = &(filename[i]);
 235
 236   i = -1;
 237   f_form = FORM_UNKNOWN;
 238   do
 239     {
 240       i++;
 241       if (strcasecmp (fileext, exttype[i].extension) == 0)
 242         {
 243           f_form = exttype[i].form;
 244           break;
 245         }
 246     }
 247   while (exttype[i].form != FORM_UNKNOWN);
 248
 249   return f_form;
 250 }
 251
 252
 253 /* Finalize commandline options.  */
 254
 255 bool
 256 gfc_post_options (const char **pfilename)
 257 {
 258   const char *filename = *pfilename, *canon_source_file = NULL;
 259   char *source_path;
 260   int i;
 261
 262   /* Excess precision other than "fast" requires front-end
 263      support.  */
 264   if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
 265       && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
 266     sorry ("-fexcess-precision=standard for Fortran");
 267   flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
 268
 269   /* Whole program needs whole file mode.  */
 270   if (flag_whole_program)
 271     gfc_option.flag_whole_file = 1;
 272
 273   /* Enable whole-file mode if LTO is in effect.  */
 274   if (flag_lto)
 275     gfc_option.flag_whole_file = 1;
 276
 277   /* Fortran allows associative math - but we cannot reassociate if
 278      we want traps or signed zeros. Cf. also flag_protect_parens.  */
 279   if (flag_associative_math == -1)
 280     flag_associative_math = (!flag_trapping_math && !flag_signed_zeros);
 281
 282   if (gfc_option.flag_protect_parens == -1)
 283     gfc_option.flag_protect_parens = !optimize_fast;
 284
 285   if (gfc_option.flag_stack_arrays == -1)
 286     gfc_option.flag_stack_arrays = optimize_fast;
 287
 288   /* By default, disable (re)allocation during assignment for -std=f95,
 289      and enable it for F2003/F2008/GNU/Legacy. */
 290   if (gfc_option.flag_realloc_lhs == -1)
 291     {
 292       if (gfc_option.allow_std & GFC_STD_F2003)
 293         gfc_option.flag_realloc_lhs = 1;
 294       else
 295         gfc_option.flag_realloc_lhs = 0;
 296     }
 297
 298   /* -fbounds-check is equivalent to -fcheck=bounds */
 299   if (flag_bounds_check)
 300     gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
 301
 302   if (flag_compare_debug)
 303     gfc_option.dump_fortran_original = 0;
 304
 305   /* Make -fmax-errors visible to gfortran's diagnostic machinery.  */
 306   if (global_options_set.x_flag_max_errors)
 307     gfc_option.max_errors = flag_max_errors;
 308
 309   /* Verify the input file name.  */
 310   if (!filename || strcmp (filename, "-") == 0)
 311     {
 312       filename = "";
 313     }
 314
 315   if (gfc_option.flag_preprocessed)
 316     {
 317       /* For preprocessed files, if the first tokens are of the form # NUM.
 318          handle the directives so we know the original file name.  */
 319       gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
 320       if (gfc_source_file == NULL)
 321         gfc_source_file = filename;
 322       else
 323         *pfilename = gfc_source_file;
 324     }
 325   else
 326     gfc_source_file = filename;
 327
 328   if (canon_source_file == NULL)
 329     canon_source_file = gfc_source_file;
 330
 331   /* Adds the path where the source file is to the list of include files.  */
 332
 333   i = strlen (canon_source_file);
 334   while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
 335     i--;
 336
 337   if (i != 0)
 338     {
 339       source_path = (char *) alloca (i + 1);
 340       memcpy (source_path, canon_source_file, i);
 341       source_path[i] = 0;
 342       gfc_add_include_path (source_path, true, true);
 343     }
 344   else
 345     gfc_add_include_path (".", true, true);
 346
 347   if (canon_source_file != gfc_source_file)
 348     free (CONST_CAST (char *, canon_source_file));
 349
 350   /* Decide which form the file will be read in as.  */
 351
 352   if (gfc_option.source_form != FORM_UNKNOWN)
 353     gfc_current_form = gfc_option.source_form;
 354   else
 355     {
 356       gfc_current_form = form_from_filename (filename);
 357
 358       if (gfc_current_form == FORM_UNKNOWN)
 359         {
 360           gfc_current_form = FORM_FREE;
 361           gfc_warning_now ("Reading file '%s' as free form",
 362                            (filename[0] == '\0') ? "<stdin>" : filename);
 363         }
 364     }
 365
 366   /* If the user specified -fd-lines-as-{code|comments} verify that we're
 367      in fixed form.  */
 368   if (gfc_current_form == FORM_FREE)
 369     {
 370       if (gfc_option.flag_d_lines == 0)
 371         gfc_warning_now ("'-fd-lines-as-comments' has no effect "
 372                          "in free form");
 373       else if (gfc_option.flag_d_lines == 1)
 374         gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
 375     }
 376
 377   /* If -pedantic, warn about the use of GNU extensions.  */
 378   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
 379     gfc_option.warn_std |= GFC_STD_GNU;
 380   /* -std=legacy -pedantic is effectively -std=gnu.  */
 381   if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
 382     gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
 383
 384   /* If the user didn't explicitly specify -f(no)-second-underscore we
 385      use it if we're trying to be compatible with f2c, and not
 386      otherwise.  */
 387   if (gfc_option.flag_second_underscore == -1)
 388     gfc_option.flag_second_underscore = gfc_option.flag_f2c;
 389
 390   if (!gfc_option.flag_automatic && gfc_option.flag_max_stack_var_size != -2
 391       && gfc_option.flag_max_stack_var_size != 0)
 392     gfc_warning_now ("Flag -fno-automatic overwrites -fmax-stack-var-size=%d",
 393                      gfc_option.flag_max_stack_var_size);
 394   else if (!gfc_option.flag_automatic && gfc_option.flag_recursive)
 395     gfc_warning_now ("Flag -fno-automatic overwrites -frecursive");
 396   else if (!gfc_option.flag_automatic && gfc_option.gfc_flag_openmp)
 397     gfc_warning_now ("Flag -fno-automatic overwrites -frecursive implied by "
 398                      "-fopenmp");
 399   else if (gfc_option.flag_max_stack_var_size != -2
 400            && gfc_option.flag_recursive)
 401     gfc_warning_now ("Flag -frecursive overwrites -fmax-stack-var-size=%d",
 402                      gfc_option.flag_max_stack_var_size);
 403   else if (gfc_option.flag_max_stack_var_size != -2
 404            && gfc_option.gfc_flag_openmp)
 405     gfc_warning_now ("Flag -fmax-stack-var-size=%d overwrites -frecursive "
 406                      "implied by -fopenmp",
 407                      gfc_option.flag_max_stack_var_size);
 408
 409   /* Implement -frecursive as -fmax-stack-var-size=-1.  */
 410   if (gfc_option.flag_recursive)
 411     gfc_option.flag_max_stack_var_size = -1;
 412
 413   /* Implied -frecursive; implemented as -fmax-stack-var-size=-1.  */
 414   if (gfc_option.flag_max_stack_var_size == -2 && gfc_option.gfc_flag_openmp
 415       && gfc_option.flag_automatic)
 416     {
 417       gfc_option.flag_recursive = 1;
 418       gfc_option.flag_max_stack_var_size = -1;
 419     }
 420
 421   /* Set default.  */
 422   if (gfc_option.flag_max_stack_var_size == -2)
 423     gfc_option.flag_max_stack_var_size = 32768;
 424
 425   /* Implement -fno-automatic as -fmax-stack-var-size=0.  */
 426   if (!gfc_option.flag_automatic)
 427     gfc_option.flag_max_stack_var_size = 0;
 428
 429   if (pedantic)
 430     {
 431       gfc_option.warn_ampersand = 1;
 432       gfc_option.warn_tabs = 0;
 433     }
 434
 435   if (pedantic && gfc_option.flag_whole_file)
 436     gfc_option.flag_whole_file = 2;
 437
 438   /* Optimization implies front end optimization, unless the user
 439      specified it directly.  */
 440
 441   if (gfc_option.flag_frontend_optimize == -1)
 442     gfc_option.flag_frontend_optimize = optimize;
 443
 444   if (gfc_option.warn_realloc_lhs_all)
 445     gfc_option.warn_realloc_lhs = 1;
 446
 447   gfc_cpp_post_options ();
 448
 449 /* FIXME: return gfc_cpp_preprocess_only ();
 450
 451    The return value of this function indicates whether the
 452    backend needs to be initialized. On -E, we don't need
 453    the backend. However, if we return 'true' here, an
 454    ICE occurs. Initializing the backend doesn't hurt much,
 455    hence, for now we can live with it as is.  */
 456   return false;
 457 }
 458
 459
 460 /* Set the options for -Wall.  */
 461
 462 static void
 463 set_Wall (int setting)
 464 {
 465   gfc_option.warn_aliasing = setting;
 466   gfc_option.warn_ampersand = setting;
 467   gfc_option.warn_c_binding_type = setting;
 468   gfc_option.gfc_warn_conversion = setting;
 469   gfc_option.warn_line_truncation = setting;
 470   gfc_option.warn_surprising = setting;
 471   gfc_option.warn_tabs = !setting;
 472   gfc_option.warn_underflow = setting;
 473   gfc_option.warn_intrinsic_shadow = setting;
 474   gfc_option.warn_intrinsics_std = setting;
 475   gfc_option.warn_character_truncation = setting;
 476   gfc_option.warn_real_q_constant = setting;
 477   gfc_option.warn_unused_dummy_argument = setting;
 478   gfc_option.warn_compare_reals = setting;
 479   gfc_option.warn_target_lifetime = setting;
 480
 481   warn_return_type = setting;
 482   warn_switch = setting;
 483   warn_uninitialized = setting;
 484   warn_maybe_uninitialized = setting;
 485 }
 486
 487
 488 static void
 489 gfc_handle_module_path_options (const char *arg)
 490 {
 491
 492   if (gfc_option.module_dir != NULL)
 493     gfc_fatal_error ("gfortran: Only one -J option allowed");
 494
 495   gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2);
 496   strcpy (gfc_option.module_dir, arg);
 497
 498   gfc_add_include_path (gfc_option.module_dir, true, false);
 499
 500   strcat (gfc_option.module_dir, "/");
 501 }
 502
 503
 504 static void
 505 gfc_handle_fpe_trap_option (const char *arg)
 506 {
 507   int result, pos = 0, n;
 508   /* precision is a backwards compatibility alias for inexact.  */
 509   static const char * const exception[] = { "invalid", "denormal", "zero",
 510                                             "overflow", "underflow",
 511                                             "inexact", "precision", NULL };
 512   static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
 513                                        GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
 514                                        GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT,
 515                                        GFC_FPE_INEXACT,
 516                                        0 };
 517
 518   while (*arg)
 519     {
 520       while (*arg == ',')
 521         arg++;
 522
 523       while (arg[pos] && arg[pos] != ',')
 524         pos++;
 525
 526       result = 0;
 527       for (n = 0; exception[n] != NULL; n++)
 528         {
 529           if (exception[n] && strncmp (exception[n], arg, pos) == 0)
 530             {
 531               gfc_option.fpe |= opt_exception[n];
 532               arg += pos;
 533               pos = 0;
 534               result = 1;
 535               break;
 536             }
 537         }
 538       if (!result)
 539         gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
 540     }
 541 }
 542
 543
 544 static void
 545 gfc_handle_coarray_option (const char *arg)
 546 {
 547   if (strcmp (arg, "none") == 0)
 548     gfc_option.coarray = GFC_FCOARRAY_NONE;
 549   else if (strcmp (arg, "single") == 0)
 550     gfc_option.coarray = GFC_FCOARRAY_SINGLE;
 551   else if (strcmp (arg, "lib") == 0)
 552     gfc_option.coarray = GFC_FCOARRAY_LIB;
 553   else
 554     gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
 555 }
 556
 557
 558 static void
 559 gfc_handle_runtime_check_option (const char *arg)
 560 {
 561   int result, pos = 0, n;
 562   static const char * const optname[] = { "all", "bounds", "array-temps",
 563                                           "recursion", "do", "pointer",
 564                                           "mem", NULL };
 565   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 566                                  GFC_RTCHECK_ARRAY_TEMPS,
 567                                  GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
 568                                  GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
 569                                  0 };
 570
 571   while (*arg)
 572     {
 573       while (*arg == ',')
 574         arg++;
 575
 576       while (arg[pos] && arg[pos] != ',')
 577         pos++;
 578
 579       result = 0;
 580       for (n = 0; optname[n] != NULL; n++)
 581         {
 582           if (optname[n] && strncmp (optname[n], arg, pos) == 0)
 583             {
 584               gfc_option.rtcheck |= optmask[n];
 585               arg += pos;
 586               pos = 0;
 587               result = 1;
 588               break;
 589             }
 590         }
 591       if (!result)
 592         gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
 593     }
 594 }
 595
 596
 597 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
 598    recognized and handled.  */
 599
 600 bool
 601 gfc_handle_option (size_t scode, const char *arg, int value,
 602                    int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
 603                    const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
 604 {
 605   bool result = true;
 606   enum opt_code code = (enum opt_code) scode;
 607
 608   if (gfc_cpp_handle_option (scode, arg, value) == 1)
 609     return true;
 610
 611   switch (code)
 612     {
 613     default:
 614       result = false;
 615       break;
 616
 617     case OPT_Wall:
 618       handle_generated_option (&global_options, &global_options_set,
 619                                OPT_Wunused, NULL, value,
 620                                gfc_option_lang_mask (), kind, loc,
 621                                handlers, global_dc);
 622       set_Wall (value);
 623       break;
 624
 625     case OPT_Waliasing:
 626       gfc_option.warn_aliasing = value;
 627       break;
 628
 629     case OPT_Wampersand:
 630       gfc_option.warn_ampersand = value;
 631       break;
 632
 633     case OPT_Warray_temporaries:
 634       gfc_option.warn_array_temp = value;
 635       break;
 636
 637     case OPT_Wc_binding_type:
 638       gfc_option.warn_c_binding_type = value;
 639       break;
 640
 641     case OPT_Wcharacter_truncation:
 642       gfc_option.warn_character_truncation = value;
 643       break;
 644
 645     case OPT_Wcompare_reals:
 646       gfc_option.warn_compare_reals = value;
 647       break;
 648
 649     case OPT_Wconversion:
 650       gfc_option.gfc_warn_conversion = value;
 651       break;
 652
 653     case OPT_Wconversion_extra:
 654       gfc_option.warn_conversion_extra = value;
 655       break;
 656
 657     case OPT_Wfunction_elimination:
 658       gfc_option.warn_function_elimination = value;
 659       break;
 660
 661     case OPT_Wimplicit_interface:
 662       gfc_option.warn_implicit_interface = value;
 663       break;
 664
 665     case OPT_Wimplicit_procedure:
 666       gfc_option.warn_implicit_procedure = value;
 667       break;
 668
 669     case OPT_Wline_truncation:
 670       gfc_option.warn_line_truncation = value;
 671       break;
 672
 673     case OPT_Wrealloc_lhs:
 674       gfc_option.warn_realloc_lhs = value;
 675       break;
 676
 677     case OPT_Wrealloc_lhs_all:
 678       gfc_option.warn_realloc_lhs_all = value;
 679       break;
 680
 681     case OPT_Wreturn_type:
 682       warn_return_type = value;
 683       break;
 684
 685     case OPT_Wsurprising:
 686       gfc_option.warn_surprising = value;
 687       break;
 688
 689     case OPT_Wtabs:
 690       gfc_option.warn_tabs = value;
 691       break;
 692
 693     case OPT_Wtarget_lifetime:
 694       gfc_option.warn_target_lifetime = value;
 695       break;
 696
 697     case OPT_Wunderflow:
 698       gfc_option.warn_underflow = value;
 699       break;
 700
 701     case OPT_Wintrinsic_shadow:
 702       gfc_option.warn_intrinsic_shadow = value;
 703       break;
 704
 705     case OPT_Walign_commons:
 706       gfc_option.warn_align_commons = value;
 707       break;
 708
 709     case OPT_Wreal_q_constant:
 710       gfc_option.warn_real_q_constant = value;
 711       break;
 712
 713     case OPT_Wunused_dummy_argument:
 714       gfc_option.warn_unused_dummy_argument = value;
 715       break;
 716
 717     case OPT_fall_intrinsics:
 718       gfc_option.flag_all_intrinsics = 1;
 719       break;
 720
 721     case OPT_fautomatic:
 722       gfc_option.flag_automatic = value;
 723       break;
 724
 725     case OPT_fallow_leading_underscore:
 726       gfc_option.flag_allow_leading_underscore = value;
 727       break;
 728
 729     case OPT_fbackslash:
 730       gfc_option.flag_backslash = value;
 731       break;
 732
 733     case OPT_fbacktrace:
 734       gfc_option.flag_backtrace = value;
 735       break;
 736
 737     case OPT_fcheck_array_temporaries:
 738       gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
 739       break;
 740
 741     case OPT_fcray_pointer:
 742       gfc_option.flag_cray_pointer = value;
 743       break;
 744
 745     case OPT_ff2c:
 746       gfc_option.flag_f2c = value;
 747       break;
 748
 749     case OPT_fdollar_ok:
 750       gfc_option.flag_dollar_ok = value;
 751       break;
 752
 753     case OPT_fexternal_blas:
 754       gfc_option.flag_external_blas = value;
 755       break;
 756
 757     case OPT_fblas_matmul_limit_:
 758       gfc_option.blas_matmul_limit = value;
 759       break;
 760
 761     case OPT_fd_lines_as_code:
 762       gfc_option.flag_d_lines = 1;
 763       break;
 764
 765     case OPT_fd_lines_as_comments:
 766       gfc_option.flag_d_lines = 0;
 767       break;
 768
 769     case OPT_fdump_fortran_original:
 770     case OPT_fdump_parse_tree:
 771       gfc_option.dump_fortran_original = value;
 772       break;
 773
 774     case OPT_fdump_fortran_optimized:
 775       gfc_option.dump_fortran_optimized = value;
 776       break;
 777
 778     case OPT_ffixed_form:
 779       gfc_option.source_form = FORM_FIXED;
 780       break;
 781
 782     case OPT_ffixed_line_length_none:
 783       gfc_option.fixed_line_length = 0;
 784       break;
 785
 786     case OPT_ffixed_line_length_:
 787       if (value != 0 && value < 7)
 788         gfc_fatal_error ("Fixed line length must be at least seven.");
 789       gfc_option.fixed_line_length = value;
 790       break;
 791
 792     case OPT_ffree_form:
 793       gfc_option.source_form = FORM_FREE;
 794       break;
 795
 796     case OPT_fopenmp:
 797       gfc_option.gfc_flag_openmp = value;
 798       break;
 799
 800     case OPT_ffree_line_length_none:
 801       gfc_option.free_line_length = 0;
 802       break;
 803
 804     case OPT_ffree_line_length_:
 805       if (value != 0 && value < 4)
 806         gfc_fatal_error ("Free line length must be at least three.");
 807       gfc_option.free_line_length = value;
 808       break;
 809
 810     case OPT_funderscoring:
 811       gfc_option.flag_underscoring = value;
 812       break;
 813
 814     case OPT_fwhole_file:
 815       gfc_option.flag_whole_file = value;
 816       break;
 817
 818     case OPT_fsecond_underscore:
 819       gfc_option.flag_second_underscore = value;
 820       break;
 821
 822     case OPT_static_libgfortran:
 823 #ifndef HAVE_LD_STATIC_DYNAMIC
 824       gfc_fatal_error ("-static-libgfortran is not supported in this "
 825                        "configuration");
 826 #endif
 827       break;
 828
 829     case OPT_fimplicit_none:
 830       gfc_option.flag_implicit_none = value;
 831       break;
 832
 833     case OPT_fintrinsic_modules_path:
 834       gfc_add_intrinsic_modules_path (arg);
 835       break;
 836
 837     case OPT_fmax_array_constructor_:
 838       gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
 839       break;
 840
 841     case OPT_fmax_stack_var_size_:
 842       gfc_option.flag_max_stack_var_size = value;
 843       break;
 844
 845     case OPT_fstack_arrays:
 846       gfc_option.flag_stack_arrays = value;
 847       break;
 848
 849     case OPT_fmodule_private:
 850       gfc_option.flag_module_private = value;
 851       break;
 852
 853     case OPT_frange_check:
 854       gfc_option.flag_range_check = value;
 855       break;
 856
 857     case OPT_fpack_derived:
 858       gfc_option.flag_pack_derived = value;
 859       break;
 860
 861     case OPT_frepack_arrays:
 862       gfc_option.flag_repack_arrays = value;
 863       break;
 864
 865     case OPT_fpreprocessed:
 866       gfc_option.flag_preprocessed = value;
 867       break;
 868
 869     case OPT_fmax_identifier_length_:
 870       if (value > GFC_MAX_SYMBOL_LEN)
 871         gfc_fatal_error ("Maximum supported identifier length is %d",
 872                          GFC_MAX_SYMBOL_LEN);
 873       gfc_option.max_identifier_length = value;
 874       break;
 875
 876     case OPT_fdefault_integer_8:
 877       gfc_option.flag_default_integer = value;
 878       break;
 879
 880     case OPT_fdefault_real_8:
 881       gfc_option.flag_default_real = value;
 882       break;
 883
 884     case OPT_fdefault_double_8:
 885       gfc_option.flag_default_double = value;
 886       break;
 887
 888     case OPT_finteger_4_integer_8:
 889       gfc_option.flag_integer4_kind = 8;
 890       break;
 891
 892     case OPT_freal_4_real_8:
 893       gfc_option.flag_real4_kind = 8;
 894       break;
 895
 896     case OPT_freal_4_real_10:
 897       gfc_option.flag_real4_kind = 10;
 898       break;
 899
 900     case OPT_freal_4_real_16:
 901       gfc_option.flag_real4_kind = 16;
 902       break;
 903
 904     case OPT_freal_8_real_4:
 905       gfc_option.flag_real8_kind = 4;
 906       break;
 907
 908     case OPT_freal_8_real_10:
 909       gfc_option.flag_real8_kind = 10;
 910       break;
 911
 912     case OPT_freal_8_real_16:
 913       gfc_option.flag_real8_kind = 16;
 914       break;
 915
 916     case OPT_finit_local_zero:
 917       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 918       gfc_option.flag_init_integer_value = 0;
 919       gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 920       gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 921       gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 922       gfc_option.flag_init_character_value = (char)0;
 923       break;
 924
 925     case OPT_finit_logical_:
 926       if (!strcasecmp (arg, "false"))
 927         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 928       else if (!strcasecmp (arg, "true"))
 929         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
 930       else
 931         gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
 932                          arg);
 933       break;
 934
 935     case OPT_finit_real_:
 936       if (!strcasecmp (arg, "zero"))
 937         gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 938       else if (!strcasecmp (arg, "nan"))
 939         gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
 940       else if (!strcasecmp (arg, "snan"))
 941         gfc_option.flag_init_real = GFC_INIT_REAL_SNAN;
 942       else if (!strcasecmp (arg, "inf"))
 943         gfc_option.flag_init_real = GFC_INIT_REAL_INF;
 944       else if (!strcasecmp (arg, "-inf"))
 945         gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
 946       else
 947         gfc_fatal_error ("Unrecognized option to -finit-real: %s",
 948                          arg);
 949       break;
 950
 951     case OPT_finit_integer_:
 952       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 953       gfc_option.flag_init_integer_value = atoi (arg);
 954       break;
 955
 956     case OPT_finit_character_:
 957       if (value >= 0 && value <= 127)
 958         {
 959           gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 960           gfc_option.flag_init_character_value = (char)value;
 961         }
 962       else
 963         gfc_fatal_error ("The value of n in -finit-character=n must be "
 964                          "between 0 and 127");
 965       break;
 966
 967     case OPT_I:
 968       gfc_add_include_path (arg, true, false);
 969       break;
 970
 971     case OPT_J:
 972       gfc_handle_module_path_options (arg);
 973       break;
 974
 975     case OPT_fsign_zero:
 976       gfc_option.flag_sign_zero = value;
 977       break;
 978
 979     case OPT_ffpe_trap_:
 980       gfc_handle_fpe_trap_option (arg);
 981       break;
 982
 983     case OPT_std_f95:
 984       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
 985                              | GFC_STD_F2008_OBS;
 986       gfc_option.warn_std = GFC_STD_F95_OBS;
 987       gfc_option.max_continue_fixed = 19;
 988       gfc_option.max_continue_free = 39;
 989       gfc_option.max_identifier_length = 31;
 990       gfc_option.warn_ampersand = 1;
 991       gfc_option.warn_tabs = 0;
 992       break;
 993
 994     case OPT_std_f2003:
 995       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 996         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
 997       gfc_option.warn_std = GFC_STD_F95_OBS;
 998       gfc_option.max_identifier_length = 63;
 999       gfc_option.warn_ampersand = 1;
1000       gfc_option.warn_tabs = 0;
1001       break;
1002
1003     case OPT_std_f2008:
1004       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
1005         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
1006       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
1007       gfc_option.max_identifier_length = 63;
1008       gfc_option.warn_ampersand = 1;
1009       gfc_option.warn_tabs = 0;
1010       break;
1011
1012     case OPT_std_f2008ts:
1013       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
1014         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS
1015         | GFC_STD_F2008_TS;
1016       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
1017       gfc_option.max_identifier_length = 63;
1018       gfc_option.warn_ampersand = 1;
1019       gfc_option.warn_tabs = 0;
1020       break;
1021
1022     case OPT_std_gnu:
1023       set_default_std_flags ();
1024       break;
1025
1026     case OPT_std_legacy:
1027       set_default_std_flags ();
1028       gfc_option.warn_std = 0;
1029       break;
1030
1031     case OPT_Wintrinsics_std:
1032       gfc_option.warn_intrinsics_std = value;
1033       break;
1034
1035     case OPT_fshort_enums:
1036       /* Handled in language-independent code.  */
1037       break;
1038
1039     case OPT_fconvert_little_endian:
1040       gfc_option.convert = GFC_CONVERT_LITTLE;
1041       break;
1042
1043     case OPT_fconvert_big_endian:
1044       gfc_option.convert = GFC_CONVERT_BIG;
1045       break;
1046
1047     case OPT_fconvert_native:
1048       gfc_option.convert = GFC_CONVERT_NATIVE;
1049       break;
1050
1051     case OPT_fconvert_swap:
1052       gfc_option.convert = GFC_CONVERT_SWAP;
1053       break;
1054
1055     case OPT_frecord_marker_4:
1056       gfc_option.record_marker = 4;
1057       break;
1058
1059     case OPT_frecord_marker_8:
1060       gfc_option.record_marker = 8;
1061       break;
1062
1063     case OPT_fmax_subrecord_length_:
1064       if (value > MAX_SUBRECORD_LENGTH)
1065         gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
1066                          MAX_SUBRECORD_LENGTH);
1067
1068       gfc_option.max_subrecord_length = value;
1069       break;
1070
1071     case OPT_frecursive:
1072       gfc_option.flag_recursive = value;
1073       break;
1074
1075     case OPT_falign_commons:
1076       gfc_option.flag_align_commons = value;
1077       break;
1078
1079     case  OPT_faggressive_function_elimination:
1080       gfc_option.flag_aggressive_function_elimination = value;
1081       break;
1082
1083     case OPT_ffrontend_optimize:
1084       gfc_option.flag_frontend_optimize = value;
1085       break;
1086
1087     case OPT_fprotect_parens:
1088       gfc_option.flag_protect_parens = value;
1089       break;
1090
1091     case OPT_frealloc_lhs:
1092       gfc_option.flag_realloc_lhs = value;
1093       break;
1094
1095     case OPT_fcheck_:
1096       gfc_handle_runtime_check_option (arg);
1097       break;
1098
1099     case OPT_fcoarray_:
1100       gfc_handle_coarray_option (arg);
1101       break;
1102     }
1103
1104   Fortran_handle_option_auto (&global_options, &global_options_set,
1105                               scode, arg, value,
1106                               gfc_option_lang_mask (), kind,
1107                               loc, handlers, global_dc);
1108   return result;
1109 }
1110
1111
1112 /* Return a string with the options passed to the compiler; used for
1113    Fortran's compiler_options() intrinsic.  */
1114
1115 char *
1116 gfc_get_option_string (void)
1117 {
1118   unsigned j;
1119   size_t len, pos;
1120   char *result;
1121
1122   /* Determine required string length.  */
1123
1124   len = 0;
1125   for (j = 1; j < save_decoded_options_count; j++)
1126     {
1127       switch (save_decoded_options[j].opt_index)
1128         {
1129         case OPT_o:
1130         case OPT_d:
1131         case OPT_dumpbase:
1132         case OPT_dumpdir:
1133         case OPT_auxbase:
1134         case OPT_quiet:
1135         case OPT_version:
1136         case OPT_fintrinsic_modules_path:
1137           /* Ignore these.  */
1138           break;
1139         default:
1140           /* Ignore file names. */
1141           if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
1142             len += 1
1143                  + strlen (save_decoded_options[j].orig_option_with_args_text);
1144         }
1145     }
1146
1147   result = XCNEWVEC (char, len);
1148
1149   pos = 0;
1150   for (j = 1; j < save_decoded_options_count; j++)
1151     {
1152       switch (save_decoded_options[j].opt_index)
1153         {
1154         case OPT_o:
1155         case OPT_d:
1156         case OPT_dumpbase:
1157         case OPT_dumpdir:
1158         case OPT_auxbase:
1159         case OPT_quiet:
1160         case OPT_version:
1161         case OPT_fintrinsic_modules_path:
1162           /* Ignore these.  */
1163           continue;
1164
1165         case OPT_cpp_:
1166           /* Use "-cpp" rather than "-cpp=<temporary file>".  */
1167           len = 4;
1168           break;
1169
1170         default:
1171           /* Ignore file names. */
1172           if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
1173             continue;
1174
1175           len = strlen (save_decoded_options[j].orig_option_with_args_text);
1176         }
1177
1178       memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
1179       pos += len;
1180       result[pos++] = ' ';
1181     }
1182
1183   result[--pos] = '\0';
1184   return result;
1185 }