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
   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-core.h"    /* For sorry.  */
  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_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.gfc_warn_conversion = 0;
 101   gfc_option.warn_conversion_extra = 0;
 102   gfc_option.warn_implicit_interface = 0;
 103   gfc_option.warn_line_truncation = 0;
 104   gfc_option.warn_surprising = 0;
 105   gfc_option.warn_tabs = 1;
 106   gfc_option.warn_underflow = 1;
 107   gfc_option.warn_intrinsic_shadow = 0;
 108   gfc_option.warn_intrinsics_std = 0;
 109   gfc_option.warn_align_commons = 1;
 110   gfc_option.warn_unused_dummy_argument = 0;
 111   gfc_option.max_errors = 25;
 112
 113   gfc_option.flag_all_intrinsics = 0;
 114   gfc_option.flag_default_double = 0;
 115   gfc_option.flag_default_integer = 0;
 116   gfc_option.flag_default_real = 0;
 117   gfc_option.flag_dollar_ok = 0;
 118   gfc_option.flag_underscoring = 1;
 119   gfc_option.flag_whole_file = 1;
 120   gfc_option.flag_f2c = 0;
 121   gfc_option.flag_second_underscore = -1;
 122   gfc_option.flag_implicit_none = 0;
 123
 124   /* Default value of flag_max_stack_var_size is set in gfc_post_options.  */
 125   gfc_option.flag_max_stack_var_size = -2;
 126
 127   gfc_option.flag_range_check = 1;
 128   gfc_option.flag_pack_derived = 0;
 129   gfc_option.flag_repack_arrays = 0;
 130   gfc_option.flag_preprocessed = 0;
 131   gfc_option.flag_automatic = 1;
 132   gfc_option.flag_backslash = 0;
 133   gfc_option.flag_module_private = 0;
 134   gfc_option.flag_backtrace = 0;
 135   gfc_option.flag_allow_leading_underscore = 0;
 136   gfc_option.flag_dump_core = 0;
 137   gfc_option.flag_external_blas = 0;
 138   gfc_option.blas_matmul_limit = 30;
 139   gfc_option.flag_cray_pointer = 0;
 140   gfc_option.flag_d_lines = -1;
 141   gfc_option.gfc_flag_openmp = 0;
 142   gfc_option.flag_sign_zero = 1;
 143   gfc_option.flag_recursive = 0;
 144   gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
 145   gfc_option.flag_init_integer_value = 0;
 146   gfc_option.flag_init_real = GFC_INIT_REAL_OFF;
 147   gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
 148   gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
 149   gfc_option.flag_init_character_value = (char)0;
 150   gfc_option.flag_align_commons = 1;
 151   gfc_option.flag_protect_parens = 1;
 152
 153   gfc_option.fpe = 0;
 154   gfc_option.rtcheck = 0;
 155   gfc_option.coarray = GFC_FCOARRAY_NONE;
 156
 157   set_default_std_flags ();
 158
 159   /* Initialize cpp-related options.  */
 160   gfc_cpp_init_options (decoded_options_count, decoded_options);
 161 }
 162
 163
 164 /* Determine the source form from the filename extension.  We assume
 165    case insensitivity.  */
 166
 167 static gfc_source_form
 168 form_from_filename (const char *filename)
 169 {
 170   static const struct
 171   {
 172     const char *extension;
 173     gfc_source_form form;
 174   }
 175   exttype[] =
 176   {
 177     {
 178     ".f90", FORM_FREE}
 179     ,
 180     {
 181     ".f95", FORM_FREE}
 182     ,
 183     {
 184     ".f03", FORM_FREE}
 185     ,
 186     {
 187     ".f08", FORM_FREE}
 188     ,
 189     {
 190     ".f", FORM_FIXED}
 191     ,
 192     {
 193     ".for", FORM_FIXED}
 194     ,
 195     {
 196     ".ftn", FORM_FIXED}
 197     ,
 198     {
 199     "", FORM_UNKNOWN}
 200   };            /* sentinel value */
 201
 202   gfc_source_form f_form;
 203   const char *fileext;
 204   int i;
 205
 206   /* Find end of file name.  Note, filename is either a NULL pointer or
 207      a NUL terminated string.  */
 208   i = 0;
 209   while (filename[i] != '\0')
 210     i++;
 211
 212   /* Find last period.  */
 213   while (i >= 0 && (filename[i] != '.'))
 214     i--;
 215
 216   /* Did we see a file extension?  */
 217   if (i < 0)
 218     return FORM_UNKNOWN; /* Nope  */
 219
 220   /* Get file extension and compare it to others.  */
 221   fileext = &(filename[i]);
 222
 223   i = -1;
 224   f_form = FORM_UNKNOWN;
 225   do
 226     {
 227       i++;
 228       if (strcasecmp (fileext, exttype[i].extension) == 0)
 229         {
 230           f_form = exttype[i].form;
 231           break;
 232         }
 233     }
 234   while (exttype[i].form != FORM_UNKNOWN);
 235
 236   return f_form;
 237 }
 238
 239
 240 /* Finalize commandline options.  */
 241
 242 bool
 243 gfc_post_options (const char **pfilename)
 244 {
 245   const char *filename = *pfilename, *canon_source_file = NULL;
 246   char *source_path;
 247   int i;
 248
 249   /* Excess precision other than "fast" requires front-end
 250      support.  */
 251   if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
 252       && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
 253     sorry ("-fexcess-precision=standard for Fortran");
 254   flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
 255
 256   /* Whole program needs whole file mode.  */
 257   if (flag_whole_program)
 258     gfc_option.flag_whole_file = 1;
 259
 260   /* Enable whole-file mode if LTO is in effect.  */
 261   if (flag_lto)
 262     gfc_option.flag_whole_file = 1;
 263
 264   /* Fortran allows associative math - but we cannot reassociate if
 265      we want traps or signed zeros. Cf. also flag_protect_parens.  */
 266   if (flag_associative_math == -1)
 267     flag_associative_math = (!flag_trapping_math && !flag_signed_zeros);
 268
 269   /* -fbounds-check is equivalent to -fcheck=bounds */
 270   if (flag_bounds_check)
 271     gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
 272
 273   if (flag_compare_debug)
 274     gfc_option.dump_fortran_original = 0;
 275
 276   /* Make -fmax-errors visible to gfortran's diagnostic machinery.  */
 277   if (global_options_set.x_flag_max_errors)
 278     gfc_option.max_errors = flag_max_errors;
 279
 280   /* Verify the input file name.  */
 281   if (!filename || strcmp (filename, "-") == 0)
 282     {
 283       filename = "";
 284     }
 285
 286   if (gfc_option.flag_preprocessed)
 287     {
 288       /* For preprocessed files, if the first tokens are of the form # NUM.
 289          handle the directives so we know the original file name.  */
 290       gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
 291       if (gfc_source_file == NULL)
 292         gfc_source_file = filename;
 293       else
 294         *pfilename = gfc_source_file;
 295     }
 296   else
 297     gfc_source_file = filename;
 298
 299   if (canon_source_file == NULL)
 300     canon_source_file = gfc_source_file;
 301
 302   /* Adds the path where the source file is to the list of include files.  */
 303
 304   i = strlen (canon_source_file);
 305   while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
 306     i--;
 307
 308   if (i != 0)
 309     {
 310       source_path = (char *) alloca (i + 1);
 311       memcpy (source_path, canon_source_file, i);
 312       source_path[i] = 0;
 313       gfc_add_include_path (source_path, true, true);
 314     }
 315   else
 316     gfc_add_include_path (".", true, true);
 317
 318   if (canon_source_file != gfc_source_file)
 319     gfc_free (CONST_CAST (char *, canon_source_file));
 320
 321   /* Decide which form the file will be read in as.  */
 322
 323   if (gfc_option.source_form != FORM_UNKNOWN)
 324     gfc_current_form = gfc_option.source_form;
 325   else
 326     {
 327       gfc_current_form = form_from_filename (filename);
 328
 329       if (gfc_current_form == FORM_UNKNOWN)
 330         {
 331           gfc_current_form = FORM_FREE;
 332           gfc_warning_now ("Reading file '%s' as free form",
 333                            (filename[0] == '\0') ? "<stdin>" : filename);
 334         }
 335     }
 336
 337   /* If the user specified -fd-lines-as-{code|comments} verify that we're
 338      in fixed form.  */
 339   if (gfc_current_form == FORM_FREE)
 340     {
 341       if (gfc_option.flag_d_lines == 0)
 342         gfc_warning_now ("'-fd-lines-as-comments' has no effect "
 343                          "in free form");
 344       else if (gfc_option.flag_d_lines == 1)
 345         gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
 346     }
 347
 348   /* If -pedantic, warn about the use of GNU extensions.  */
 349   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
 350     gfc_option.warn_std |= GFC_STD_GNU;
 351   /* -std=legacy -pedantic is effectively -std=gnu.  */
 352   if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
 353     gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
 354
 355   /* If the user didn't explicitly specify -f(no)-second-underscore we
 356      use it if we're trying to be compatible with f2c, and not
 357      otherwise.  */
 358   if (gfc_option.flag_second_underscore == -1)
 359     gfc_option.flag_second_underscore = gfc_option.flag_f2c;
 360
 361   if (!gfc_option.flag_automatic && gfc_option.flag_max_stack_var_size != -2
 362       && gfc_option.flag_max_stack_var_size != 0)
 363     gfc_warning_now ("Flag -fno-automatic overwrites -fmax-stack-var-size=%d",
 364                      gfc_option.flag_max_stack_var_size);
 365   else if (!gfc_option.flag_automatic && gfc_option.flag_recursive)
 366     gfc_warning_now ("Flag -fno-automatic overwrites -frecursive");
 367   else if (!gfc_option.flag_automatic && gfc_option.gfc_flag_openmp)
 368     gfc_warning_now ("Flag -fno-automatic overwrites -frecursive implied by "
 369                      "-fopenmp");
 370   else if (gfc_option.flag_max_stack_var_size != -2
 371            && gfc_option.flag_recursive)
 372     gfc_warning_now ("Flag -frecursive overwrites -fmax-stack-var-size=%d",
 373                      gfc_option.flag_max_stack_var_size);
 374   else if (gfc_option.flag_max_stack_var_size != -2
 375            && gfc_option.gfc_flag_openmp)
 376     gfc_warning_now ("Flag -fmax-stack-var-size=%d overwrites -frecursive "
 377                      "implied by -fopenmp",
 378                      gfc_option.flag_max_stack_var_size);
 379
 380   /* Implement -frecursive as -fmax-stack-var-size=-1.  */
 381   if (gfc_option.flag_recursive)
 382     gfc_option.flag_max_stack_var_size = -1;
 383
 384   /* Implied -frecursive; implemented as -fmax-stack-var-size=-1.  */
 385   if (gfc_option.flag_max_stack_var_size == -2 && gfc_option.gfc_flag_openmp
 386       && gfc_option.flag_automatic)
 387     {
 388       gfc_option.flag_recursive = 1;
 389       gfc_option.flag_max_stack_var_size = -1;
 390     }
 391
 392   /* Set default.  */
 393   if (gfc_option.flag_max_stack_var_size == -2)
 394     gfc_option.flag_max_stack_var_size = 32768;
 395
 396   /* Implement -fno-automatic as -fmax-stack-var-size=0.  */
 397   if (!gfc_option.flag_automatic)
 398     gfc_option.flag_max_stack_var_size = 0;
 399
 400   if (pedantic)
 401     {
 402       gfc_option.warn_ampersand = 1;
 403       gfc_option.warn_tabs = 0;
 404     }
 405
 406   if (pedantic && gfc_option.flag_whole_file)
 407     gfc_option.flag_whole_file = 2;
 408
 409   gfc_cpp_post_options ();
 410
 411 /* FIXME: return gfc_cpp_preprocess_only ();
 412
 413    The return value of this function indicates whether the
 414    backend needs to be initialized. On -E, we don't need
 415    the backend. However, if we return 'true' here, an
 416    ICE occurs. Initializing the backend doesn't hurt much,
 417    hence, for now we can live with it as is.  */
 418   return false;
 419 }
 420
 421
 422 /* Set the options for -Wall.  */
 423
 424 static void
 425 set_Wall (int setting)
 426 {
 427   gfc_option.warn_aliasing = setting;
 428   gfc_option.warn_ampersand = setting;
 429   gfc_option.gfc_warn_conversion = setting;
 430   gfc_option.warn_line_truncation = setting;
 431   gfc_option.warn_surprising = setting;
 432   gfc_option.warn_tabs = !setting;
 433   gfc_option.warn_underflow = setting;
 434   gfc_option.warn_intrinsic_shadow = setting;
 435   gfc_option.warn_intrinsics_std = setting;
 436   gfc_option.warn_character_truncation = setting;
 437   gfc_option.warn_unused_dummy_argument = setting;
 438
 439   warn_unused = setting;
 440   warn_return_type = setting;
 441   warn_switch = setting;
 442   warn_uninitialized = setting;
 443 }
 444
 445
 446 static void
 447 gfc_handle_module_path_options (const char *arg)
 448 {
 449
 450   if (gfc_option.module_dir != NULL)
 451     gfc_fatal_error ("gfortran: Only one -J option allowed");
 452
 453   gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2);
 454   strcpy (gfc_option.module_dir, arg);
 455   strcat (gfc_option.module_dir, "/");
 456
 457   gfc_add_include_path (gfc_option.module_dir, true, false);
 458 }
 459
 460
 461 static void
 462 gfc_handle_fpe_trap_option (const char *arg)
 463 {
 464   int result, pos = 0, n;
 465   static const char * const exception[] = { "invalid", "denormal", "zero",
 466                                             "overflow", "underflow",
 467                                             "precision", NULL };
 468   static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
 469                                        GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
 470                                        GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION,
 471                                        0 };
 472
 473   while (*arg)
 474     {
 475       while (*arg == ',')
 476         arg++;
 477
 478       while (arg[pos] && arg[pos] != ',')
 479         pos++;
 480
 481       result = 0;
 482       for (n = 0; exception[n] != NULL; n++)
 483         {
 484           if (exception[n] && strncmp (exception[n], arg, pos) == 0)
 485             {
 486               gfc_option.fpe |= opt_exception[n];
 487               arg += pos;
 488               pos = 0;
 489               result = 1;
 490               break;
 491             }
 492         }
 493       if (!result)
 494         gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
 495     }
 496 }
 497
 498
 499 static void
 500 gfc_handle_coarray_option (const char *arg)
 501 {
 502   if (strcmp (arg, "none") == 0)
 503     gfc_option.coarray = GFC_FCOARRAY_NONE;
 504   else if (strcmp (arg, "single") == 0)
 505     gfc_option.coarray = GFC_FCOARRAY_SINGLE;
 506   else
 507     gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
 508 }
 509
 510
 511 static void
 512 gfc_handle_runtime_check_option (const char *arg)
 513 {
 514   int result, pos = 0, n;
 515   static const char * const optname[] = { "all", "bounds", "array-temps",
 516                                           "recursion", "do", "pointer",
 517                                           "mem", NULL };
 518   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 519                                  GFC_RTCHECK_ARRAY_TEMPS,
 520                                  GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
 521                                  GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
 522                                  0 };
 523
 524   while (*arg)
 525     {
 526       while (*arg == ',')
 527         arg++;
 528
 529       while (arg[pos] && arg[pos] != ',')
 530         pos++;
 531
 532       result = 0;
 533       for (n = 0; optname[n] != NULL; n++)
 534         {
 535           if (optname[n] && strncmp (optname[n], arg, pos) == 0)
 536             {
 537               gfc_option.rtcheck |= optmask[n];
 538               arg += pos;
 539               pos = 0;
 540               result = 1;
 541               break;
 542             }
 543         }
 544       if (!result)
 545         gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
 546     }
 547 }
 548
 549
 550 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
 551    recognized and handled.  */
 552
 553 bool
 554 gfc_handle_option (size_t scode, const char *arg, int value,
 555                    int kind ATTRIBUTE_UNUSED,
 556                    const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
 557 {
 558   bool result = true;
 559   enum opt_code code = (enum opt_code) scode;
 560
 561   if (gfc_cpp_handle_option (scode, arg, value) == 1)
 562     return true;
 563
 564   switch (code)
 565     {
 566     default:
 567       result = false;
 568       break;
 569
 570     case OPT_Wall:
 571       set_Wall (value);
 572       break;
 573
 574     case OPT_Waliasing:
 575       gfc_option.warn_aliasing = value;
 576       break;
 577
 578     case OPT_Wampersand:
 579       gfc_option.warn_ampersand = value;
 580       break;
 581
 582     case OPT_Warray_temporaries:
 583       gfc_option.warn_array_temp = value;
 584       break;
 585
 586     case OPT_Wcharacter_truncation:
 587       gfc_option.warn_character_truncation = value;
 588       break;
 589
 590     case OPT_Wconversion:
 591       gfc_option.gfc_warn_conversion = value;
 592       break;
 593
 594     case OPT_Wconversion_extra:
 595       gfc_option.warn_conversion_extra = value;
 596       break;
 597
 598     case OPT_Wimplicit_interface:
 599       gfc_option.warn_implicit_interface = value;
 600       break;
 601
 602     case OPT_Wimplicit_procedure:
 603       gfc_option.warn_implicit_procedure = value;
 604       break;
 605
 606     case OPT_Wline_truncation:
 607       gfc_option.warn_line_truncation = value;
 608       break;
 609
 610     case OPT_Wreturn_type:
 611       warn_return_type = value;
 612       break;
 613
 614     case OPT_Wsurprising:
 615       gfc_option.warn_surprising = value;
 616       break;
 617
 618     case OPT_Wtabs:
 619       gfc_option.warn_tabs = value;
 620       break;
 621
 622     case OPT_Wunderflow:
 623       gfc_option.warn_underflow = value;
 624       break;
 625
 626     case OPT_Wintrinsic_shadow:
 627       gfc_option.warn_intrinsic_shadow = value;
 628       break;
 629
 630     case OPT_Walign_commons:
 631       gfc_option.warn_align_commons = value;
 632       break;
 633
 634     case OPT_Wunused_dummy_argument:
 635       gfc_option.warn_unused_dummy_argument = value;
 636       break;
 637
 638     case OPT_fall_intrinsics:
 639       gfc_option.flag_all_intrinsics = 1;
 640       break;
 641
 642     case OPT_fautomatic:
 643       gfc_option.flag_automatic = value;
 644       break;
 645
 646     case OPT_fallow_leading_underscore:
 647       gfc_option.flag_allow_leading_underscore = value;
 648       break;
 649
 650     case OPT_fbackslash:
 651       gfc_option.flag_backslash = value;
 652       break;
 653
 654     case OPT_fbacktrace:
 655       gfc_option.flag_backtrace = value;
 656       break;
 657
 658     case OPT_fcheck_array_temporaries:
 659       gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
 660       break;
 661
 662     case OPT_fdump_core:
 663       gfc_option.flag_dump_core = value;
 664       break;
 665
 666     case OPT_fcray_pointer:
 667       gfc_option.flag_cray_pointer = value;
 668       break;
 669
 670     case OPT_ff2c:
 671       gfc_option.flag_f2c = value;
 672       break;
 673
 674     case OPT_fdollar_ok:
 675       gfc_option.flag_dollar_ok = value;
 676       break;
 677
 678     case OPT_fexternal_blas:
 679       gfc_option.flag_external_blas = value;
 680       break;
 681
 682     case OPT_fblas_matmul_limit_:
 683       gfc_option.blas_matmul_limit = value;
 684       break;
 685
 686     case OPT_fd_lines_as_code:
 687       gfc_option.flag_d_lines = 1;
 688       break;
 689
 690     case OPT_fd_lines_as_comments:
 691       gfc_option.flag_d_lines = 0;
 692       break;
 693
 694     case OPT_fdump_fortran_original:
 695     case OPT_fdump_parse_tree:
 696       gfc_option.dump_fortran_original = value;
 697       break;
 698
 699     case OPT_fdump_fortran_optimized:
 700       gfc_option.dump_fortran_optimized = value;
 701       break;
 702
 703     case OPT_ffixed_form:
 704       gfc_option.source_form = FORM_FIXED;
 705       break;
 706
 707     case OPT_ffixed_line_length_none:
 708       gfc_option.fixed_line_length = 0;
 709       break;
 710
 711     case OPT_ffixed_line_length_:
 712       if (value != 0 && value < 7)
 713         gfc_fatal_error ("Fixed line length must be at least seven.");
 714       gfc_option.fixed_line_length = value;
 715       break;
 716
 717     case OPT_ffree_form:
 718       gfc_option.source_form = FORM_FREE;
 719       break;
 720
 721     case OPT_fopenmp:
 722       gfc_option.gfc_flag_openmp = value;
 723       break;
 724
 725     case OPT_ffree_line_length_none:
 726       gfc_option.free_line_length = 0;
 727       break;
 728
 729     case OPT_ffree_line_length_:
 730       if (value != 0 && value < 4)
 731         gfc_fatal_error ("Free line length must be at least three.");
 732       gfc_option.free_line_length = value;
 733       break;
 734
 735     case OPT_funderscoring:
 736       gfc_option.flag_underscoring = value;
 737       break;
 738
 739     case OPT_fwhole_file:
 740       gfc_option.flag_whole_file = value;
 741       break;
 742
 743     case OPT_fsecond_underscore:
 744       gfc_option.flag_second_underscore = value;
 745       break;
 746
 747     case OPT_static_libgfortran:
 748 #ifndef HAVE_LD_STATIC_DYNAMIC
 749       gfc_fatal_error ("-static-libgfortran is not supported in this "
 750                        "configuration");
 751 #endif
 752       break;
 753
 754     case OPT_fimplicit_none:
 755       gfc_option.flag_implicit_none = value;
 756       break;
 757
 758     case OPT_fintrinsic_modules_path:
 759       gfc_add_include_path (arg, false, false);
 760       gfc_add_intrinsic_modules_path (arg);
 761       break;
 762
 763     case OPT_fmax_array_constructor_:
 764       gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
 765       break;
 766
 767     case OPT_fmax_stack_var_size_:
 768       gfc_option.flag_max_stack_var_size = value;
 769       break;
 770
 771     case OPT_fmodule_private:
 772       gfc_option.flag_module_private = value;
 773       break;
 774
 775     case OPT_frange_check:
 776       gfc_option.flag_range_check = value;
 777       break;
 778
 779     case OPT_fpack_derived:
 780       gfc_option.flag_pack_derived = value;
 781       break;
 782
 783     case OPT_frepack_arrays:
 784       gfc_option.flag_repack_arrays = value;
 785       break;
 786
 787     case OPT_fpreprocessed:
 788       gfc_option.flag_preprocessed = value;
 789       break;
 790
 791     case OPT_fmax_identifier_length_:
 792       if (value > GFC_MAX_SYMBOL_LEN)
 793         gfc_fatal_error ("Maximum supported identifier length is %d",
 794                          GFC_MAX_SYMBOL_LEN);
 795       gfc_option.max_identifier_length = value;
 796       break;
 797
 798     case OPT_fdefault_integer_8:
 799       gfc_option.flag_default_integer = value;
 800       break;
 801
 802     case OPT_fdefault_real_8:
 803       gfc_option.flag_default_real = value;
 804       break;
 805
 806     case OPT_fdefault_double_8:
 807       gfc_option.flag_default_double = value;
 808       break;
 809
 810     case OPT_finit_local_zero:
 811       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 812       gfc_option.flag_init_integer_value = 0;
 813       gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 814       gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 815       gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 816       gfc_option.flag_init_character_value = (char)0;
 817       break;
 818
 819     case OPT_finit_logical_:
 820       if (!strcasecmp (arg, "false"))
 821         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 822       else if (!strcasecmp (arg, "true"))
 823         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
 824       else
 825         gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
 826                          arg);
 827       break;
 828
 829     case OPT_finit_real_:
 830       if (!strcasecmp (arg, "zero"))
 831         gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 832       else if (!strcasecmp (arg, "nan"))
 833         gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
 834       else if (!strcasecmp (arg, "snan"))
 835         gfc_option.flag_init_real = GFC_INIT_REAL_SNAN;
 836       else if (!strcasecmp (arg, "inf"))
 837         gfc_option.flag_init_real = GFC_INIT_REAL_INF;
 838       else if (!strcasecmp (arg, "-inf"))
 839         gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
 840       else
 841         gfc_fatal_error ("Unrecognized option to -finit-real: %s",
 842                          arg);
 843       break;
 844
 845     case OPT_finit_integer_:
 846       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 847       gfc_option.flag_init_integer_value = atoi (arg);
 848       break;
 849
 850     case OPT_finit_character_:
 851       if (value >= 0 && value <= 127)
 852         {
 853           gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 854           gfc_option.flag_init_character_value = (char)value;
 855         }
 856       else
 857         gfc_fatal_error ("The value of n in -finit-character=n must be "
 858                          "between 0 and 127");
 859       break;
 860
 861     case OPT_I:
 862       gfc_add_include_path (arg, true, false);
 863       break;
 864
 865     case OPT_J:
 866       gfc_handle_module_path_options (arg);
 867       break;
 868
 869     case OPT_fsign_zero:
 870       gfc_option.flag_sign_zero = value;
 871       break;
 872
 873     case OPT_ffpe_trap_:
 874       gfc_handle_fpe_trap_option (arg);
 875       break;
 876
 877     case OPT_std_f95:
 878       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
 879                              | GFC_STD_F2008_OBS;
 880       gfc_option.warn_std = GFC_STD_F95_OBS;
 881       gfc_option.max_continue_fixed = 19;
 882       gfc_option.max_continue_free = 39;
 883       gfc_option.max_identifier_length = 31;
 884       gfc_option.warn_ampersand = 1;
 885       gfc_option.warn_tabs = 0;
 886       break;
 887
 888     case OPT_std_f2003:
 889       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 890         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
 891       gfc_option.warn_std = GFC_STD_F95_OBS;
 892       gfc_option.max_identifier_length = 63;
 893       gfc_option.warn_ampersand = 1;
 894       gfc_option.warn_tabs = 0;
 895       break;
 896
 897     case OPT_std_f2008:
 898       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 899         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
 900       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
 901       gfc_option.max_identifier_length = 63;
 902       gfc_option.warn_ampersand = 1;
 903       gfc_option.warn_tabs = 0;
 904       break;
 905
 906     case OPT_std_gnu:
 907       set_default_std_flags ();
 908       break;
 909
 910     case OPT_std_legacy:
 911       set_default_std_flags ();
 912       gfc_option.warn_std = 0;
 913       break;
 914
 915     case OPT_Wintrinsics_std:
 916       gfc_option.warn_intrinsics_std = value;
 917       break;
 918
 919     case OPT_fshort_enums:
 920       /* Handled in language-independent code.  */
 921       break;
 922
 923     case OPT_fconvert_little_endian:
 924       gfc_option.convert = GFC_CONVERT_LITTLE;
 925       break;
 926
 927     case OPT_fconvert_big_endian:
 928       gfc_option.convert = GFC_CONVERT_BIG;
 929       break;
 930
 931     case OPT_fconvert_native:
 932       gfc_option.convert = GFC_CONVERT_NATIVE;
 933       break;
 934
 935     case OPT_fconvert_swap:
 936       gfc_option.convert = GFC_CONVERT_SWAP;
 937       break;
 938
 939     case OPT_frecord_marker_4:
 940       gfc_option.record_marker = 4;
 941       break;
 942
 943     case OPT_frecord_marker_8:
 944       gfc_option.record_marker = 8;
 945       break;
 946
 947     case OPT_fmax_subrecord_length_:
 948       if (value > MAX_SUBRECORD_LENGTH)
 949         gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
 950                          MAX_SUBRECORD_LENGTH);
 951
 952       gfc_option.max_subrecord_length = value;
 953       break;
 954
 955     case OPT_frecursive:
 956       gfc_option.flag_recursive = value;
 957       break;
 958
 959     case OPT_falign_commons:
 960       gfc_option.flag_align_commons = value;
 961       break;
 962
 963     case OPT_fprotect_parens:
 964       gfc_option.flag_protect_parens = value;
 965       break;
 966
 967     case OPT_fcheck_:
 968       gfc_handle_runtime_check_option (arg);
 969       break;
 970
 971     case OPT_fcoarray_:
 972       gfc_handle_coarray_option (arg);
 973       break;
 974     }
 975
 976   return result;
 977 }
 978
 979
 980 /* Return a string with the options passed to the compiler; used for
 981    Fortran's compiler_options() intrinsic.  */
 982
 983 char *
 984 gfc_get_option_string (void)
 985 {
 986   unsigned j;
 987   size_t len, pos;
 988   char *result;
 989
 990   /* Determine required string length.  */
 991
 992   len = 0;
 993   for (j = 1; j < save_decoded_options_count; j++)
 994     {
 995       switch (save_decoded_options[j].opt_index)
 996         {
 997         case OPT_o:
 998         case OPT_d:
 999         case OPT_dumpbase:
1000         case OPT_dumpdir:
1001         case OPT_auxbase:
1002         case OPT_quiet:
1003         case OPT_version:
1004         case OPT_fintrinsic_modules_path:
1005           /* Ignore these.  */
1006           break;
1007         default:
1008           /* Ignore file names. */
1009           if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
1010             len += 1
1011                  + strlen (save_decoded_options[j].orig_option_with_args_text);
1012         }
1013     }
1014
1015   result = (char *) gfc_getmem (len);
1016
1017   pos = 0;
1018   for (j = 1; j < save_decoded_options_count; j++)
1019     {
1020       switch (save_decoded_options[j].opt_index)
1021         {
1022         case OPT_o:
1023         case OPT_d:
1024         case OPT_dumpbase:
1025         case OPT_dumpdir:
1026         case OPT_auxbase:
1027         case OPT_quiet:
1028         case OPT_version:
1029         case OPT_fintrinsic_modules_path:
1030           /* Ignore these.  */
1031           continue;
1032
1033         case OPT_cpp_:
1034           /* Use "-cpp" rather than "-cpp=<temporary file>".  */
1035           len = 4;
1036           break;
1037
1038         default:
1039           /* Ignore file names. */
1040           if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
1041             continue;
1042
1043           len = strlen (save_decoded_options[j].orig_option_with_args_text);
1044         }
1045
1046       memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
1047       pos += len;
1048       result[pos++] = ' ';
1049     }
1050
1051   result[--pos] = '\0';
1052   return result;
1053 }