OSDN Git Service

c98049922e6a8a596e128d3df2a88388144d6cf2
[pf3gnuchains/gcc-fork.git] / gcc / fortran / options.c
1 /* Parse and display command line options.
2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
3    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
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.max_identifier_length = GFC_MAX_SYMBOL_LEN;
50   gfc_option.verbose = 0;
51
52   gfc_option.warn_aliasing = 0;
53   gfc_option.warn_conversion = 0;
54   gfc_option.warn_implicit_interface = 0;
55   gfc_option.warn_line_truncation = 0;
56   gfc_option.warn_underflow = 1;
57   gfc_option.warn_surprising = 0;
58   gfc_option.warn_unused_labels = 0;
59
60   gfc_option.flag_default_double = 0;
61   gfc_option.flag_default_integer = 0;
62   gfc_option.flag_default_real = 0;
63   gfc_option.flag_dollar_ok = 0;
64   gfc_option.flag_underscoring = 1;
65   gfc_option.flag_f2c = 0;
66   gfc_option.flag_second_underscore = -1;
67   gfc_option.flag_implicit_none = 0;
68   gfc_option.flag_max_stack_var_size = 32768;
69   gfc_option.flag_module_access_private = 0;
70   gfc_option.flag_no_backend = 0;
71   gfc_option.flag_pack_derived = 0;
72   gfc_option.flag_repack_arrays = 0;
73   gfc_option.flag_backslash = 1;
74   gfc_option.flag_d_lines = -1;
75
76   gfc_option.q_kind = gfc_default_double_kind;
77
78   flag_argument_noalias = 2;
79   flag_errno_math = 0;
80
81   gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
82     | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU
83     | GFC_STD_LEGACY;
84   gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
85     | GFC_STD_F2003 | GFC_STD_LEGACY;
86
87   gfc_option.warn_nonstd_intrinsics = 0;
88
89   return CL_F95;
90 }
91
92
93 /* Determine the source form from the filename extension.  We assume
94    case insensitivity.  */
95
96 static gfc_source_form
97 form_from_filename (const char *filename)
98 {
99
100   static const struct
101   {
102     const char *extension;
103     gfc_source_form form;
104   }
105   exttype[] =
106   {
107     {
108     ".f90", FORM_FREE}
109     ,
110     {
111     ".f95", FORM_FREE}
112     ,
113     {
114     ".f", FORM_FIXED}
115     ,
116     {
117     ".for", FORM_FIXED}
118     ,
119     {
120     "", FORM_UNKNOWN}
121   };            /* sentinel value */
122
123   gfc_source_form f_form;
124   const char *fileext;
125   int i;
126
127   /* Find end of file name.  Note, filename is either a NULL pointer or
128      a NUL terminated string.  */
129   i = 0;
130   while (filename[i] != '\0')
131     i++;
132
133   /* Find last period.  */
134   while (i >= 0 && (filename[i] != '.'))
135     i--;
136
137   /* Did we see a file extension?  */
138   if (i < 0)
139     return FORM_UNKNOWN; /* Nope  */
140
141   /* Get file extension and compare it to others.  */
142   fileext = &(filename[i]);
143
144   i = -1;
145   f_form = FORM_UNKNOWN;
146   do
147     {
148       i++;
149       if (strcasecmp (fileext, exttype[i].extension) == 0)
150         {
151           f_form = exttype[i].form;
152           break;
153         }
154     }
155   while (exttype[i].form != FORM_UNKNOWN);
156
157   return f_form;
158 }
159
160
161 /* Finalize commandline options.  */
162
163 bool
164 gfc_post_options (const char **pfilename)
165 {
166   const char *filename = *pfilename;
167
168   /* Verify the input file name.  */
169   if (!filename || strcmp (filename, "-") == 0)
170     {
171       filename = "";
172     }
173
174   gfc_source_file = filename;
175
176   /* Decide which form the file will be read in as.  */
177
178   if (gfc_option.source_form != FORM_UNKNOWN)
179     gfc_current_form = gfc_option.source_form;
180   else
181     {
182       gfc_current_form = form_from_filename (filename);
183
184       if (gfc_current_form == FORM_UNKNOWN)
185         {
186           gfc_current_form = FORM_FREE;
187           gfc_warning_now ("Reading file '%s' as free form.", 
188                            (filename[0] == '\0') ? "<stdin>" : filename); 
189         }
190     }
191
192   /* If the user specified -fd-lines-as-{code|comments} verify that we're
193      in fixed form.  */
194   if (gfc_current_form == FORM_FREE)
195     {
196       if (gfc_option.flag_d_lines == 0)
197         gfc_warning_now ("'-fd-lines-as-comments' has no effect "
198                          "in free form.");
199       else if (gfc_option.flag_d_lines == 1)
200         gfc_warning_now ("'-fd-lines-as-code' has no effect "
201                          "in free form.");
202     }
203
204   flag_inline_trees = 1;
205
206   /* Use tree inlining.  */
207   if (!flag_no_inline)
208     flag_no_inline = 1;
209   if (flag_inline_functions)
210     flag_inline_trees = 2;
211
212   /* If -pedantic, warn about the use of GNU extensions.  */
213   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
214     gfc_option.warn_std |= GFC_STD_GNU;
215   /* -std=legacy -pedantic is effectively -std=gnu.  */
216   if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
217     gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
218
219   /* If the user didn't explicitly specify -f(no)-second-underscore we
220      use it if we're trying to be compatible with f2c, and not
221      otherwise.  */
222   if (gfc_option.flag_second_underscore == -1)
223     gfc_option.flag_second_underscore = gfc_option.flag_f2c;
224
225   return false;
226 }
227
228
229 /* Set the options for -Wall.  */
230
231 static void
232 set_Wall (void)
233 {
234
235   gfc_option.warn_aliasing = 1;
236   gfc_option.warn_line_truncation = 1;
237   gfc_option.warn_underflow = 1;
238   gfc_option.warn_surprising = 1;
239   gfc_option.warn_unused_labels = 1;
240   gfc_option.warn_nonstd_intrinsics = 1;
241
242   set_Wunused (1);
243   warn_return_type = 1;
244   warn_switch = 1;
245
246   /* We save the value of warn_uninitialized, since if they put
247      -Wuninitialized on the command line, we need to generate a
248      warning about not using it without also specifying -O.  */
249
250   if (warn_uninitialized != 1)
251     warn_uninitialized = 2;
252 }
253
254
255 static void
256 gfc_handle_module_path_options (const char *arg)
257 {
258
259   if (gfc_option.module_dir != NULL)
260     {
261       gfc_status ("gfortran: Only one -M option allowed\n");
262       exit (3);
263     }
264
265   if (arg == NULL)
266     {
267       gfc_status ("gfortran: Directory required after -M\n");
268       exit (3);
269     }
270
271   gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2);
272   strcpy (gfc_option.module_dir, arg);
273   strcat (gfc_option.module_dir, "/");
274 }
275
276 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
277    recognized and handled.  */
278 int
279 gfc_handle_option (size_t scode, const char *arg, int value)
280 {
281   int result = 1;
282   enum opt_code code = (enum opt_code) scode;
283
284   /* Ignore file names.  */
285   if (code == N_OPTS)
286     return 1;
287
288   switch (code)
289     {
290     default:
291       result = 0;
292       break;
293
294     case OPT_Wall:
295       set_Wall ();
296       break;
297
298     case OPT_Waliasing:
299       gfc_option.warn_aliasing = value;
300       break;
301
302     case OPT_Wconversion:
303       gfc_option.warn_conversion = value;
304       break;
305
306     case OPT_Wimplicit_interface:
307       gfc_option.warn_implicit_interface = value;
308       break;
309
310     case OPT_Wline_truncation:
311       gfc_option.warn_line_truncation = value;
312       break;
313
314     case OPT_Wunderflow:
315       gfc_option.warn_underflow = value;
316       break;
317
318     case OPT_Wsurprising:
319       gfc_option.warn_surprising = value;
320       break;
321
322     case OPT_Wunused_labels:
323       gfc_option.warn_unused_labels = value;
324       break;
325
326     case OPT_ff2c:
327       gfc_option.flag_f2c = value;
328       break;
329
330     case OPT_fdollar_ok:
331       gfc_option.flag_dollar_ok = value;
332       break;
333
334     case OPT_fbackslash:
335       gfc_option.flag_backslash = value;
336       break;
337
338     case OPT_fd_lines_as_code:
339       gfc_option.flag_d_lines = 1;
340       break;
341
342     case OPT_fd_lines_as_comments:
343       gfc_option.flag_d_lines = 0;
344       break;
345
346     case OPT_fdump_parse_tree:
347       gfc_option.verbose = value;
348       break;
349
350     case OPT_ffixed_form:
351       gfc_option.source_form = FORM_FIXED;
352       break;
353
354     case OPT_ffree_form:
355       gfc_option.source_form = FORM_FREE;
356       break;
357
358     case OPT_funderscoring:
359       gfc_option.flag_underscoring = value;
360       break;
361
362     case OPT_fsecond_underscore:
363       gfc_option.flag_second_underscore = value;
364       break;
365
366     case OPT_fimplicit_none:
367       gfc_option.flag_implicit_none = value;
368       break;
369
370     case OPT_fmax_stack_var_size_:
371       gfc_option.flag_max_stack_var_size = value;
372       break;
373
374     case OPT_fmodule_private:
375       gfc_option.flag_module_access_private = value;
376       break;
377
378     case OPT_fno_backend:
379       gfc_option.flag_no_backend = value;
380       break;
381
382     case OPT_fpack_derived:
383       gfc_option.flag_pack_derived = value;
384       break;
385
386     case OPT_frepack_arrays:
387       gfc_option.flag_repack_arrays = value;
388       break;
389
390     case OPT_ffixed_line_length_none:
391       gfc_option.fixed_line_length = 0;
392       break;
393
394     case OPT_ffixed_line_length_:
395       if (value != 0 && value < 7)
396         gfc_fatal_error ("Fixed line length must be at least seven.");
397       gfc_option.fixed_line_length = value;
398       break;
399
400     case OPT_fmax_identifier_length_:
401       if (value > GFC_MAX_SYMBOL_LEN)
402         gfc_fatal_error ("Maximum supported idenitifier length is %d",
403                          GFC_MAX_SYMBOL_LEN);
404       gfc_option.max_identifier_length = value;
405       break;
406
407     case OPT_qkind_:
408       if (gfc_validate_kind (BT_REAL, value, true) < 0)
409         gfc_fatal_error ("Argument to -fqkind isn't a valid real kind");
410       gfc_option.q_kind = value;
411       break;
412
413     case OPT_fdefault_integer_8:
414       gfc_option.flag_default_integer = value;
415       break;
416
417     case OPT_fdefault_real_8:
418       gfc_option.flag_default_real = value;
419       break;
420
421     case OPT_fdefault_double_8:
422       gfc_option.flag_default_double = value;
423       break;
424
425     case OPT_I:
426       gfc_add_include_path (arg);
427       break;
428
429     case OPT_J:
430     case OPT_M:
431       gfc_handle_module_path_options (arg);
432       break;
433     
434     case OPT_std_f95:
435       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77;
436       gfc_option.warn_std = GFC_STD_F95_OBS;
437       gfc_option.max_identifier_length = 31;
438       break;
439
440     case OPT_std_f2003:
441       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
442         | GFC_STD_F2003 | GFC_STD_F95;
443       gfc_option.warn_std = GFC_STD_F95_OBS;
444       gfc_option.max_identifier_length = 63;
445       break;
446
447     case OPT_std_gnu:
448       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
449         | GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
450         | GFC_STD_GNU | GFC_STD_LEGACY;
451       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
452         | GFC_STD_LEGACY;
453       break;
454
455     case OPT_std_legacy:
456       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
457         | GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
458         | GFC_STD_GNU | GFC_STD_LEGACY;
459       gfc_option.warn_std = 0;
460       break;
461
462     case OPT_Wnonstd_intrinsics:
463       gfc_option.warn_nonstd_intrinsics = 1;
464       break;
465     }
466
467   return result;
468 }