OSDN Git Service

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