OSDN Git Service

bd8f6ebf05e6fd38148da9d3cee938ae6e3c1148
[pf3gnuchains/gcc-fork.git] / gcc / fortran / options.c
1 /* Parse and display command line options.
2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
3    Free Software Foundation, Inc.
4    Contributed by Andy Vaught
5
6 This file is part of GCC.
7
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
11 version.
12
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING.  If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
21 02110-1301, USA.  */
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 "options.h"
31 #include "params.h"
32 #include "tree-inline.h"
33 #include "gfortran.h"
34 #include "target.h"
35
36 gfc_option_t gfc_option;
37
38
39 /* Get ready for options handling.  */
40
41 unsigned int
42 gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
43                   const char **argv ATTRIBUTE_UNUSED)
44 {
45   gfc_source_file = NULL;
46   gfc_option.module_dir = NULL;
47   gfc_option.source_form = FORM_UNKNOWN;
48   gfc_option.fixed_line_length = 72;
49   gfc_option.free_line_length = 132;
50   gfc_option.max_continue_fixed = 19;
51   gfc_option.max_continue_free = 39;
52   gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
53   gfc_option.max_subrecord_length = 0;
54   gfc_option.convert = CONVERT_NATIVE;
55   gfc_option.record_marker = 0;
56   gfc_option.verbose = 0;
57
58   gfc_option.warn_aliasing = 0;
59   gfc_option.warn_ampersand = 0;
60   gfc_option.warn_character_truncation = 0;
61   gfc_option.warn_conversion = 0;
62   gfc_option.warn_implicit_interface = 0;
63   gfc_option.warn_line_truncation = 0;
64   gfc_option.warn_surprising = 0;
65   gfc_option.warn_tabs = 1;
66   gfc_option.warn_underflow = 1;
67   gfc_option.max_errors = 25;
68
69   gfc_option.flag_all_intrinsics = 0;
70   gfc_option.flag_default_double = 0;
71   gfc_option.flag_default_integer = 0;
72   gfc_option.flag_default_real = 0;
73   gfc_option.flag_dollar_ok = 0;
74   gfc_option.flag_underscoring = 1;
75   gfc_option.flag_f2c = 0;
76   gfc_option.flag_second_underscore = -1;
77   gfc_option.flag_implicit_none = 0;
78   gfc_option.flag_max_stack_var_size = 32768;
79   gfc_option.flag_range_check = 1;
80   gfc_option.flag_pack_derived = 0;
81   gfc_option.flag_repack_arrays = 0;
82   gfc_option.flag_preprocessed = 0;
83   gfc_option.flag_automatic = 1;
84   gfc_option.flag_backslash = 1;
85   gfc_option.flag_allow_leading_underscore = 0;
86   gfc_option.flag_dump_core = 0;
87   gfc_option.flag_external_blas = 0;
88   gfc_option.blas_matmul_limit = 30;
89   gfc_option.flag_cray_pointer = 0;
90   gfc_option.flag_d_lines = -1;
91   gfc_option.flag_openmp = 0;
92
93   gfc_option.fpe = 0;
94
95   /* Argument pointers cannot point to anything but their argument.  */
96   flag_argument_noalias = 3;
97
98   flag_errno_math = 0;
99
100   gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
101     | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU
102     | GFC_STD_LEGACY;
103   gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
104
105   gfc_option.warn_nonstd_intrinsics = 0;
106
107   /* -fshort-enums can be default on some targets.  */
108   gfc_option.fshort_enums = targetm.default_short_enums ();
109
110   /* Increase MAX_ALIASED_VOPS to account for different characteristics
111      of Fortran regarding VOPs.  */
112   MAX_ALIASED_VOPS = 50;
113
114   return CL_Fortran;
115 }
116
117
118 /* Determine the source form from the filename extension.  We assume
119    case insensitivity.  */
120
121 static gfc_source_form
122 form_from_filename (const char *filename)
123 {
124   static const struct
125   {
126     const char *extension;
127     gfc_source_form form;
128   }
129   exttype[] =
130   {
131     {
132     ".f90", FORM_FREE}
133     ,
134     {
135     ".f95", FORM_FREE}
136     ,
137     {
138     ".f03", FORM_FREE}
139     ,
140     {
141     ".f", FORM_FIXED}
142     ,
143     {
144     ".for", FORM_FIXED}
145     ,
146     {
147     "", FORM_UNKNOWN}
148   };            /* sentinel value */
149
150   gfc_source_form f_form;
151   const char *fileext;
152   int i;
153
154   /* Find end of file name.  Note, filename is either a NULL pointer or
155      a NUL terminated string.  */
156   i = 0;
157   while (filename[i] != '\0')
158     i++;
159
160   /* Find last period.  */
161   while (i >= 0 && (filename[i] != '.'))
162     i--;
163
164   /* Did we see a file extension?  */
165   if (i < 0)
166     return FORM_UNKNOWN; /* Nope  */
167
168   /* Get file extension and compare it to others.  */
169   fileext = &(filename[i]);
170
171   i = -1;
172   f_form = FORM_UNKNOWN;
173   do
174     {
175       i++;
176       if (strcasecmp (fileext, exttype[i].extension) == 0)
177         {
178           f_form = exttype[i].form;
179           break;
180         }
181     }
182   while (exttype[i].form != FORM_UNKNOWN);
183
184   return f_form;
185 }
186
187
188 /* Finalize commandline options.  */
189
190 bool
191 gfc_post_options (const char **pfilename)
192 {
193   const char *filename = *pfilename, *canon_source_file = NULL;
194   char *source_path;
195   int i;
196
197   /* Verify the input file name.  */
198   if (!filename || strcmp (filename, "-") == 0)
199     {
200       filename = "";
201     }
202
203   if (gfc_option.flag_preprocessed)
204     {
205       /* For preprocessed files, if the first tokens are of the form # NUM.
206          handle the directives so we know the original file name.  */
207       gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
208       if (gfc_source_file == NULL)
209         gfc_source_file = filename;
210       else
211         *pfilename = gfc_source_file;
212     }
213   else
214     gfc_source_file = filename;
215
216   if (canon_source_file == NULL)
217     canon_source_file = gfc_source_file;
218
219   /* Adds the path where the source file is to the list of include files.  */
220
221   i = strlen (canon_source_file);
222   while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
223     i--;
224
225   if (i != 0)
226     {
227       source_path = alloca (i + 1);
228       memcpy (source_path, canon_source_file, i);
229       source_path[i] = 0;
230       gfc_add_include_path (source_path, true);
231     }
232   else
233     gfc_add_include_path (".", true);
234
235   if (canon_source_file != gfc_source_file)
236     gfc_free ((void *) canon_source_file);
237
238   /* Decide which form the file will be read in as.  */
239
240   if (gfc_option.source_form != FORM_UNKNOWN)
241     gfc_current_form = gfc_option.source_form;
242   else
243     {
244       gfc_current_form = form_from_filename (filename);
245
246       if (gfc_current_form == FORM_UNKNOWN)
247         {
248           gfc_current_form = FORM_FREE;
249           gfc_warning_now ("Reading file '%s' as free form", 
250                            (filename[0] == '\0') ? "<stdin>" : filename);
251         }
252     }
253
254   /* If the user specified -fd-lines-as-{code|comments} verify that we're
255      in fixed form.  */
256   if (gfc_current_form == FORM_FREE)
257     {
258       if (gfc_option.flag_d_lines == 0)
259         gfc_warning_now ("'-fd-lines-as-comments' has no effect "
260                          "in free form");
261       else if (gfc_option.flag_d_lines == 1)
262         gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
263     }
264
265   flag_inline_trees = 1;
266
267   /* Use tree inlining.  */
268   if (!flag_no_inline)
269     flag_no_inline = 1;
270   if (flag_inline_functions)
271     flag_inline_trees = 2;
272
273   /* If -pedantic, warn about the use of GNU extensions.  */
274   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
275     gfc_option.warn_std |= GFC_STD_GNU;
276   /* -std=legacy -pedantic is effectively -std=gnu.  */
277   if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
278     gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
279
280   /* If the user didn't explicitly specify -f(no)-second-underscore we
281      use it if we're trying to be compatible with f2c, and not
282      otherwise.  */
283   if (gfc_option.flag_second_underscore == -1)
284     gfc_option.flag_second_underscore = gfc_option.flag_f2c;
285
286   /* Implement -fno-automatic as -fmax-stack-var-size=0.  */
287   if (!gfc_option.flag_automatic)
288     gfc_option.flag_max_stack_var_size = 0;
289   
290   if (pedantic)
291     { 
292       gfc_option.warn_ampersand = 1;
293       gfc_option.warn_tabs = 0;
294     }
295
296   if (gfc_option.flag_all_intrinsics)
297     gfc_option.warn_nonstd_intrinsics = 0;
298
299   return false;
300 }
301
302
303 /* Set the options for -Wall.  */
304
305 static void
306 set_Wall (int setting)
307 {
308   gfc_option.warn_aliasing = setting;
309   gfc_option.warn_ampersand = setting;
310   gfc_option.warn_line_truncation = setting;
311   gfc_option.warn_nonstd_intrinsics = setting;
312   gfc_option.warn_surprising = setting;
313   gfc_option.warn_tabs = !setting;
314   gfc_option.warn_underflow = setting;
315   gfc_option.warn_character_truncation = setting;
316
317   set_Wunused (setting);
318   warn_return_type = setting;
319   warn_switch = setting;
320
321   /* We save the value of warn_uninitialized, since if they put
322      -Wuninitialized on the command line, we need to generate a
323      warning about not using it without also specifying -O.  */
324   if (setting == 0)
325     warn_uninitialized = 0;
326   else if (warn_uninitialized != 1)
327     warn_uninitialized = 2;
328 }
329
330
331 static void
332 gfc_handle_module_path_options (const char *arg)
333 {
334
335   if (gfc_option.module_dir != NULL)
336     {
337       gfc_status ("gfortran: Only one -M option allowed\n");
338       exit (3);
339     }
340
341   if (arg == NULL)
342     {
343       gfc_status ("gfortran: Directory required after -M\n");
344       exit (3);
345     }
346
347   gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2);
348   strcpy (gfc_option.module_dir, arg);
349   strcat (gfc_option.module_dir, "/");
350
351   gfc_add_include_path (gfc_option.module_dir, true);
352 }
353
354
355 static void
356 gfc_handle_fpe_trap_option (const char *arg)
357 {
358   int result, pos = 0, n;
359   static const char * const exception[] = { "invalid", "denormal", "zero",
360                                             "overflow", "underflow",
361                                             "precision", NULL };
362   static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
363                                        GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
364                                        GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION,
365                                        0 };
366  
367   while (*arg)
368     {
369       while (*arg == ',')
370         arg++;
371
372       while (arg[pos] && arg[pos] != ',')
373         pos++;
374
375       result = 0;
376       for (n = 0; exception[n] != NULL; n++)
377         {
378           if (exception[n] && strncmp (exception[n], arg, pos) == 0)
379             {
380               gfc_option.fpe |= opt_exception[n];
381               arg += pos;
382               pos = 0;
383               result = 1;
384               break;
385             }
386         }
387       if (!result)
388         gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
389     }
390 }
391
392
393 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
394    recognized and handled.  */
395
396 int
397 gfc_handle_option (size_t scode, const char *arg, int value)
398 {
399   int result = 1;
400   enum opt_code code = (enum opt_code) scode;
401
402   /* Ignore file names.  */
403   if (code == N_OPTS)
404     return 1;
405
406   switch (code)
407     {
408     default:
409       result = 0;
410       break;
411
412     case OPT_Wall:
413       set_Wall (value);
414       break;
415
416     case OPT_Waliasing:
417       gfc_option.warn_aliasing = value;
418       break;
419
420     case OPT_Wampersand:
421       gfc_option.warn_ampersand = value;
422       break;
423
424     case OPT_Wcharacter_truncation:
425       gfc_option.warn_character_truncation = value;
426       break;
427
428     case OPT_Wconversion:
429       gfc_option.warn_conversion = value;
430       break;
431
432     case OPT_Wimplicit_interface:
433       gfc_option.warn_implicit_interface = value;
434       break;
435
436     case OPT_Wline_truncation:
437       gfc_option.warn_line_truncation = value;
438       break;
439
440     case OPT_Wsurprising:
441       gfc_option.warn_surprising = value;
442       break;
443
444     case OPT_Wtabs:
445       gfc_option.warn_tabs = value;
446       break;
447
448     case OPT_Wunderflow:
449       gfc_option.warn_underflow = value;
450       break;
451
452     case OPT_fall_intrinsics:
453       gfc_option.flag_all_intrinsics = 1;
454       break;
455
456     case OPT_fautomatic:
457       gfc_option.flag_automatic = value;
458       break;
459
460     case OPT_fallow_leading_underscore:
461       gfc_option.flag_allow_leading_underscore = value;
462       break;
463       
464     case OPT_fbackslash:
465       gfc_option.flag_backslash = value;
466       break;
467       
468     case OPT_fdump_core:
469       gfc_option.flag_dump_core = value;
470       break;
471
472     case OPT_fcray_pointer:
473       gfc_option.flag_cray_pointer = value;
474       break;
475
476     case OPT_ff2c:
477       gfc_option.flag_f2c = value;
478       break;
479
480     case OPT_fdollar_ok:
481       gfc_option.flag_dollar_ok = value;
482       break;
483
484     case OPT_fexternal_blas:
485       gfc_option.flag_external_blas = value;
486       break;
487
488     case OPT_fblas_matmul_limit_:
489       gfc_option.blas_matmul_limit = value;
490       break;
491
492     case OPT_fd_lines_as_code:
493       gfc_option.flag_d_lines = 1;
494       break;
495
496     case OPT_fd_lines_as_comments:
497       gfc_option.flag_d_lines = 0;
498       break;
499
500     case OPT_fdump_parse_tree:
501       gfc_option.verbose = value;
502       break;
503
504     case OPT_ffixed_form:
505       gfc_option.source_form = FORM_FIXED;
506       break;
507
508     case OPT_ffixed_line_length_none:
509       gfc_option.fixed_line_length = 0;
510       break;
511
512     case OPT_ffixed_line_length_:
513       if (value != 0 && value < 7)
514         gfc_fatal_error ("Fixed line length must be at least seven.");
515       gfc_option.fixed_line_length = value;
516       break;
517
518     case OPT_ffree_form:
519       gfc_option.source_form = FORM_FREE;
520       break;
521
522     case OPT_fopenmp:
523       gfc_option.flag_openmp = value;
524       break;
525
526     case OPT_ffree_line_length_none:
527       gfc_option.free_line_length = 0;
528       break;
529
530     case OPT_ffree_line_length_:
531       gfc_option.free_line_length = value;
532       break;
533
534     case OPT_funderscoring:
535       gfc_option.flag_underscoring = value;
536       break;
537
538     case OPT_fsecond_underscore:
539       gfc_option.flag_second_underscore = value;
540       break;
541
542     case OPT_fimplicit_none:
543       gfc_option.flag_implicit_none = value;
544       break;
545
546     case OPT_fintrinsic_modules_path:
547       gfc_add_include_path (arg, false);
548       gfc_add_intrinsic_modules_path (arg);
549       break;
550
551     case OPT_fmax_errors_:
552       gfc_option.max_errors = value;
553       break;
554
555     case OPT_fmax_stack_var_size_:
556       gfc_option.flag_max_stack_var_size = value;
557       break;
558
559     case OPT_frange_check:
560       gfc_option.flag_range_check = value;
561       break;
562
563     case OPT_fpack_derived:
564       gfc_option.flag_pack_derived = value;
565       break;
566
567     case OPT_frepack_arrays:
568       gfc_option.flag_repack_arrays = value;
569       break;
570
571     case OPT_fpreprocessed:
572       gfc_option.flag_preprocessed = value;
573       break;
574
575     case OPT_fmax_identifier_length_:
576       if (value > GFC_MAX_SYMBOL_LEN)
577         gfc_fatal_error ("Maximum supported identifier length is %d",
578                          GFC_MAX_SYMBOL_LEN);
579       gfc_option.max_identifier_length = value;
580       break;
581
582     case OPT_fdefault_integer_8:
583       gfc_option.flag_default_integer = value;
584       break;
585
586     case OPT_fdefault_real_8:
587       gfc_option.flag_default_real = value;
588       break;
589
590     case OPT_fdefault_double_8:
591       gfc_option.flag_default_double = value;
592       break;
593
594     case OPT_I:
595       gfc_add_include_path (arg, true);
596       break;
597
598     case OPT_J:
599     case OPT_M:
600       gfc_handle_module_path_options (arg);
601       break;
602     
603     case OPT_ffpe_trap_:
604       gfc_handle_fpe_trap_option (arg);
605       break;
606
607     case OPT_std_f95:
608       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77;
609       gfc_option.warn_std = GFC_STD_F95_OBS;
610       gfc_option.max_identifier_length = 31;
611       gfc_option.warn_ampersand = 1;
612       gfc_option.warn_tabs = 0;
613       break;
614
615     case OPT_std_f2003:
616       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
617         | GFC_STD_F2003 | GFC_STD_F95;
618       gfc_option.warn_std = GFC_STD_F95_OBS;
619       gfc_option.max_continue_fixed = 255;
620       gfc_option.max_continue_free = 255;
621       gfc_option.max_identifier_length = 63;
622       gfc_option.warn_ampersand = 1;
623       gfc_option.warn_tabs = 0;
624       break;
625
626     case OPT_std_gnu:
627       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
628         | GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
629         | GFC_STD_GNU | GFC_STD_LEGACY;
630       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
631         | GFC_STD_LEGACY;
632       break;
633
634     case OPT_std_legacy:
635       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
636         | GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
637         | GFC_STD_GNU | GFC_STD_LEGACY;
638       gfc_option.warn_std = 0;
639       break;
640
641     case OPT_Wnonstd_intrinsics:
642       gfc_option.warn_nonstd_intrinsics = value;
643       break;
644
645     case OPT_fshort_enums:
646       gfc_option.fshort_enums = 1;
647       break;
648
649     case OPT_fconvert_little_endian:
650       gfc_option.convert = CONVERT_LITTLE;
651       break;
652
653     case OPT_fconvert_big_endian:
654       gfc_option.convert = CONVERT_BIG;
655       break;
656
657     case OPT_fconvert_native:
658       gfc_option.convert = CONVERT_NATIVE;
659       break;
660
661     case OPT_fconvert_swap:
662       gfc_option.convert = CONVERT_SWAP;
663       break;
664
665     case OPT_frecord_marker_4:
666       gfc_option.record_marker = 4;
667       break;
668
669     case OPT_frecord_marker_8:
670       gfc_option.record_marker = 8;
671       break;
672
673     case OPT_fmax_subrecord_length_:
674       if (value > MAX_SUBRECORD_LENGTH)
675         gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
676                          MAX_SUBRECORD_LENGTH);
677
678       gfc_option.max_subrecord_length = value;
679     }
680
681   return result;
682 }