OSDN Git Service

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