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