This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
Attached patch adds the intrinsic ISO_FORTRAN_ENV module to gfortran, as well as general support for intrinsic modules and the F2003-style USE statement. I first thought this might wait until the ISO_C_BINDING module is added, but seeing that Christopher encounters problems with his paperwork, we agreed it's best to submit it now, and then it will be relatively easy to change his patch (I volunteer to do it) to use the framework I'm proposing here.
I'm not submitting this patch for formal review yet, because of a few questions I'd like your opinion about. The patch mostly works, but for the following testcases:
-- I think CHARACTER_STORAGE_SIZE and FILE_STORAGE_SIZE have value 8 on all the systems we currently support. For NUMERIC_STORAGE_SIZE, however, I'm not sure what to do. The standard says "The value of the default integer scalar constant NUMERIC STORAGE SIZE is the size expressed in bits of the numeric storage unit (16.4.3.1)." Then 16.4.3.1 says "A nonpointer scalar object of type default integer, default real, or default logical occupies a single numeric storage unit". Now the question is:
When the compiler is used with -fdefault-real-8 or -fdefault-integer-8 (but not both), what the heck should the value of NUMERIC_STORAGE_SIZE be?
-- I've used the attr.intrinsic bit for the module symbol to specifiy that it's an intrinsic module. Except one line in resolve.c (see diff), it seems to be safe. However, I'd like a) to be sure that, for every user module symbol created, the intrinsic bit is set to 0, so that we check that a non-intrinsic and an intrinsic module of the same name aren't used b) the code USEing non-intrinsic modules (in module.c) to issue an error if an intrinsic module of the same name was already USEd; ie, I'd like the following to error out (while, with my patch, it does not):
module iso_fortran_env end module iso_fortran_env
program foo use, intrinsic :: iso_fortran_env use, non_intrinsic :: iso_fortran_env ! This should issue an error end program foo
Attachment:
iso_fortran_env.ChangeLog
Description: Binary data
Index: iso-fortran-env.def =================================================================== --- iso-fortran-env.def (revision 0) +++ iso-fortran-env.def (revision 0) @@ -0,0 +1,35 @@ +/* Copyright (C) 2006 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 2, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING. If not, write to the Free +Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. */ + +/* This file contains the definition of the named integer constants provided + by the Fortran 2003 ISO_FORTRAN_ENV intrinsic module. */ + +/* The arguments to NAMED_INTCST are: + -- an internal name + -- the symbol name in the module, as seen by Fortran code + -- the value it has */ + +NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", 8) +NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", 0) +NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8) +NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", 5) +NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", -1) +NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", -2) +NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", 32) +NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", 6) Index: module.c =================================================================== --- module.c (revision 117947) +++ module.c (working copy) @@ -173,6 +173,9 @@ /* The name of the module we're reading (USE'ing) or writing. */ static char module_name[GFC_MAX_SYMBOL_LEN + 1]; +/* The way the module we're reading was specified. */ +static bool specified_nonint, specified_int; + static int module_line, module_column, only_flag; static enum { IO_INPUT, IO_OUTPUT } @@ -483,12 +486,55 @@ match gfc_match_use (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; gfc_use_rename *tail = NULL, *new; interface_type type; gfc_intrinsic_op operator; match m; + specified_int = false; + specified_nonint = false; + + if (gfc_match (" , ") == MATCH_YES) + { + if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) + { + if (gfc_notify_std (GFC_STD_F2003, "New in Fortran 2003: module" + "nature in USE statement at %C") == FAILURE) + return MATCH_ERROR; + + if (strcmp (module_nature, "intrinsic") == 0) + specified_int = true; + else + { + if (strcmp (module_nature, "non_intrinsic") == 0) + specified_nonint = true; + else + { + gfc_error ("Module nature in USE statement at %C should " + "be either INTRINSIC or NON_INTRINSIC"); + return MATCH_ERROR; + } + } + } + else + return m; + } + else + { + m = gfc_match (" ::"); + if (gfc_notify_std (GFC_STD_F2003, "New in Fortran 2003: " + "\"USE :: module\" at %C") == FAILURE) + return MATCH_ERROR; + + if (m != MATCH_YES) + { + m = gfc_match ("% "); + if (m != MATCH_YES) + return m; + } + } + m = gfc_match_name (module_name); if (m != MATCH_YES) return m; @@ -3783,6 +3829,116 @@ } +/* Add an integer named constant from a given module. */ +static void +create_int_parameter (const char *name, int value, const char *modname) +{ + gfc_symtree * tmp_symtree; + gfc_symbol * sym; + + tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); + if (tmp_symtree != NULL) + { + if (strcmp (modname, tmp_symtree->n.sym->module) == 0) + return; + else + gfc_error ("Symbol '%s' already declared", name); + } + + gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree); + sym = tmp_symtree->n.sym; + + sym->module = gfc_get_string (modname); + sym->attr.flavor = FL_PARAMETER; + sym->ts.type = BT_INTEGER; + sym->ts.kind = gfc_default_integer_kind; + sym->value = gfc_int_expr (value); + sym->attr.use_assoc = 1; +} + +/* USE the ISO_FORTRAN_ENV intrinsic module. */ +void +use_iso_fortran_env_module (void) +{ + static char mod[] = "iso_fortran_env"; + const char *local_name; + gfc_use_rename *u; + gfc_symbol *mod_sym; + gfc_symtree *mod_symtree; + int i; + + static const mstring symbol[] = { +#define NAMED_INTCST(a,b,c) minit(b,c), +#include "iso-fortran-env.def" +#undef NAMED_INTCST + minit (NULL, -1234) }; + + /* Generate the symbol for the module itself. */ + mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod); + if (mod_symtree == NULL) + { + gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree); + gcc_assert (mod_symtree); + mod_sym = mod_symtree->n.sym; + + mod_sym->attr.flavor = FL_MODULE; + mod_sym->attr.intrinsic = 1; + mod_sym->module = gfc_get_string (mod); + } + else + if (!mod_symtree->n.sym->attr.intrinsic) + gfc_error ("Use of intrinsic module '%s' at %C conflicts with " + "non-intrinsic module name used previously", mod); + + /* Generate the symbols for the module integer named constants. */ + if (only_flag) + for (u = gfc_rename_list; u; u = u->next) + { + for (i = 0; symbol[i].string; i++) + if (strcmp (symbol[i].string, u->use_name) == 0) + break; + + if (symbol[i].string == NULL) + { + gfc_error ("Symbol '%s' referenced at %L does not exist in " + "intrinsic module ISO_FORTRAN_ENV", u->use_name, + &u->where); + continue; + } + + create_int_parameter (u->local_name[0] ? u->local_name + : symbol[i].string, + symbol[i].tag, mod); + } + else + { + for (i = 0; symbol[i].string; i++) + { + local_name = NULL; + for (u = gfc_rename_list; u; u = u->next) + { + if (strcmp (symbol[i].string, u->use_name) == 0) + { + local_name = u->local_name; + u->found = 1; + break; + } + } + create_int_parameter (local_name ? local_name : symbol[i].string, + symbol[i].tag, mod); + } + + for (u = gfc_rename_list; u; u = u->next) + { + if (u->found) + continue; + + gfc_error ("Symbol '%s' referenced at %L not found in intrinsic " + "module ISO_FORTRAN_ENV", u->use_name, &u->where); + } + } +} + /* Process a USE directive. */ void @@ -3797,7 +3953,29 @@ strcpy (filename, module_name); strcat (filename, MODULE_EXTENSION); - module_fp = gfc_open_included_file (filename, true); + /* First, try to find an non-intrinsic module, unless the USE statement + specified that the module is intrinsic. */ + module_fp = NULL; + if (!specified_int) + module_fp = gfc_open_included_file (filename, true); + + /* Then, see if it's an intrinsic one, unless the USE statement + specified that the module is non-intrinsic. */ + if (module_fp == NULL && !specified_nonint) + { + if (strcmp (module_name, "iso_fortran_env") == 0 + && gfc_notify_std (GFC_STD_F2003, "New in Fortran 2003: " + "ISO_FORTRAN_ENV intrinsic module at %C") != FAILURE) + { + use_iso_fortran_env_module (); + return; + } + + if (specified_int) + gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C", + module_name); + } + if (module_fp == NULL) gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s", filename, strerror (errno)); Index: resolve.c =================================================================== --- resolve.c (revision 117947) +++ resolve.c (working copy) @@ -6004,7 +6004,7 @@ } /* Make sure that intrinsic exist */ - if (sym->attr.intrinsic + if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic && ! gfc_intrinsic_name(sym->name, 0) && ! gfc_intrinsic_name(sym->name, 1)) gfc_error("Intrinsic at %L does not exist", &sym->declared_at); Index: parse.c =================================================================== --- parse.c (revision 117947) +++ parse.c (working copy) @@ -279,7 +279,7 @@ break; case 'u': - match ("use% ", gfc_match_use, ST_USE); + match ("use", gfc_match_use, ST_USE); break; case 'w':
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |