Index: gcc/fortran/iso-fortran-env.def =================================================================== --- gcc/fortran/iso-fortran-env.def (revision 0) +++ gcc/fortran/iso-fortran-env.def (revision 0) @@ -0,0 +1,37 @@ +/* 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", \ + gfc_character_storage_size) +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", \ + gfc_numeric_storage_size) +NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", 6) Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 118202) +++ gcc/fortran/gfortran.h (working copy) @@ -1823,6 +1823,8 @@ extern int gfc_default_complex_kind; extern int gfc_c_int_kind; extern int gfc_intio_kind; +extern int gfc_numeric_storage_size; +extern int gfc_character_storage_size; /* symbol.c */ void gfc_clear_new_implicit (void); Index: gcc/fortran/module.c =================================================================== --- gcc/fortran/module.c (revision 118202) +++ gcc/fortran/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,133 @@ } +/* 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. */ +static 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; + + 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; + } + + if ((gfc_option.flag_default_integer || gfc_option.flag_default_real) + && strcmp (symbol[i].string, "numeric_storage_size") == 0) + gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant " + "from intrinsic module ISO_FORTRAN_ENV at %L is " + "incompatible with option %s", &u->where, + gfc_option.flag_default_integer + ? "-fdefault-integer-8" : "-fdefault-real-8"); + + 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; + } + } + + if ((gfc_option.flag_default_integer || gfc_option.flag_default_real) + && strcmp (symbol[i].string, "numeric_storage_size") == 0) + gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant " + "from intrinsic module ISO_FORTRAN_ENV at %C is " + "incompatible with option %s", + gfc_option.flag_default_integer + ? "-fdefault-integer-8" : "-fdefault-real-8"); + + 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 @@ -3791,17 +3964,48 @@ char *filename; gfc_state_data *p; int c, line, start; + gfc_symtree *mod_symtree; filename = (char *) alloca(strlen(module_name) + strlen(MODULE_EXTENSION) + 1); 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)); + /* Check that we haven't already USEd an intrinsic module with the + same name. */ + + mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, module_name); + if (mod_symtree && mod_symtree->n.sym->attr.intrinsic) + gfc_error ("Use of non-intrinsic module '%s' at %C conflicts with " + "intrinsic module name used previously", module_name); + iomode = IO_INPUT; module_line = 1; module_column = 1; Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 118202) +++ gcc/fortran/trans-types.c (working copy) @@ -97,6 +97,10 @@ kind=8, this will be set to 8, otherwise it is set to 4. */ int gfc_intio_kind; +/* The size of the numeric storage unit and character storage unit. */ +int gfc_numeric_storage_size; +int gfc_character_storage_size; + /* Query the target to determine which machine modes are available for computation. Choose KIND numbers for them. */ @@ -228,11 +232,22 @@ if (!saw_i8) fatal_error ("integer kind=8 not available for -fdefault-integer-8 option"); gfc_default_integer_kind = 8; + + /* Even if the user specified that the default integer kind be 8, + the numerica storage size isn't 64. In this case, a warning will + be issued when NUMERIC_STORAGE_SIZE is used. */ + gfc_numeric_storage_size = 4 * 8; } else if (saw_i4) - gfc_default_integer_kind = 4; + { + gfc_default_integer_kind = 4; + gfc_numeric_storage_size = 4 * 8; + } else - gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind; + { + gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind; + gfc_numeric_storage_size = gfc_default_integer_kind * 8; + } /* Choose the default real kind. Again, we choose 4 when possible. */ if (gfc_option.flag_default_real) @@ -283,6 +298,7 @@ /* Choose the smallest integer kind for our default character. */ gfc_default_character_kind = gfc_integer_kinds[0].kind; + gfc_character_storage_size = gfc_default_character_kind * 8; /* Choose the integer kind the same size as "void*" for our index kind. */ gfc_index_integer_kind = POINTER_SIZE / 8; Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 118202) +++ gcc/fortran/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: gcc/fortran/parse.c =================================================================== --- gcc/fortran/parse.c (revision 118202) +++ gcc/fortran/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: gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 (revision 0) @@ -0,0 +1,29 @@ +! { dg-do run } +subroutine foo1 (x,y) + use iso_fortran_env + integer, intent(out) :: x, y + + x = numeric_storage_size + y = character_storage_size +end + +subroutine foo2 (x,y) + use iso_fortran_env, foo => numeric_storage_size + integer, intent(in) :: x, y + + if (foo /= x .or. character_storage_size /= y) call abort +end + +subroutine foo3 (x,y) + use iso_fortran_env, only : numeric_storage_size, character_storage_size + integer, intent(in) :: x, y + + if (numeric_storage_size /= x .or. character_storage_size /= y) call abort +end + +program test + integer :: x, y + call foo1(x,y) + call foo2(x,y) + call foo3(x,y) +end Index: gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 (revision 0) @@ -0,0 +1,14 @@ +! { dg-do compile } +module iso_fortran_env +end module iso_fortran_env + +program foo + use, intrinsic :: iso_fortran_env + use, non_intrinsic :: iso_fortran_env ! { dg-error "conflicts with intrinsic module" } +end program foo + +subroutine truc + use, non_intrinsic :: iso_fortran_env + use, intrinsic :: iso_fortran_env ! { dg-error "conflicts with non-intrinsic module" } +end subroutine truc +! { dg-final { cleanup-modules "iso_fortran_env" } } Index: gcc/testsuite/gfortran.dg/use_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/use_1.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/use_1.f90 (revision 0) @@ -0,0 +1,9 @@ + ! { dg-do compile } + ! { dg-options "-ffixed-form" } + module foo + end module foo + + subroutine bar1 + usefoo + end + ! { dg-final { cleanup-modules "iso_fortran_env" } } Index: gcc/testsuite/gfortran.dg/use_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/use_2.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/use_2.f90 (revision 0) @@ -0,0 +1,4 @@ +! { dg-do compile } +subroutine bar1 + usefoo ! { dg-error "Unclassifiable statement" } +end Index: gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 (revision 0) @@ -0,0 +1,44 @@ +! { dg-do run } +module iso_fortran_env + real :: x +end module iso_fortran_env + +subroutine bar + use , intrinsic :: iso_fortran_env + implicit none + + if (file_storage_size /= 8) call abort + if (character_storage_size /= 8) call abort + if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort + if (input_unit /= 5) call abort + if (output_unit /= 6) call abort + if (error_unit /= 0) call abort + if (iostat_end /= -1) call abort + if (iostat_eor /= -2) call abort +end + +subroutine bar2 + use , intrinsic :: iso_fortran_env, only : file_storage_size, & + character_storage_size, numeric_storage_size, input_unit, output_unit, & + error_unit, iostat_end, iostat_eor + implicit none + + if (file_storage_size /= 8) call abort + if (character_storage_size /= 8) call abort + if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort + if (input_unit /= 5) call abort + if (output_unit /= 6) call abort + if (error_unit /= 0) call abort + if (iostat_end /= -1) call abort + if (iostat_eor /= -2) call abort +end + +program test + use , intrinsic :: iso_fortran_env, uu => output_unit + implicit none + + if (input_unit /= 5 .or. uu /= 6) call abort + call bar + call bar2 +end +! { dg-final { cleanup-modules "iso_fortran_env" } } Index: gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 (revision 0) @@ -0,0 +1,76 @@ +! { dg-do compile } +module iso_fortran_env + logical :: x +end module iso_fortran_env + +subroutine bar1 + use , intrinsic :: iso_fortran_env + print *, character_storage_size +end + +subroutine bar2 + use, intrinsic :: iso_fortran_env + print *, character_storage_size +end + +subroutine bar3 + use,intrinsic :: iso_fortran_env + print *, character_storage_size +end + +subroutine bar4 + use,intrinsic::iso_fortran_env + print *, character_storage_size +end + +subroutine bar5 + use ,intrinsic :: iso_fortran_env + print *, character_storage_size +end + +subroutine foo1 + use :: iso_fortran_env + print *, x +end + +subroutine foo2 + use:: iso_fortran_env + print *, x +end + +subroutine foo3 + use::iso_fortran_env + print *, x +end + +subroutine foo4 + use ::iso_fortran_env + print *, x +end + +subroutine gee1 + use , non_intrinsic :: iso_fortran_env + print *, x +end + +subroutine gee2 + use, non_intrinsic :: iso_fortran_env + print *, x +end + +subroutine gee3 + use,non_intrinsic :: iso_fortran_env + print *, x +end + +subroutine gee4 + use,non_intrinsic::iso_fortran_env + print *, x +end + +subroutine gee5 + use ,non_intrinsic :: iso_fortran_env + print *, x +end + +! { dg-final { cleanup-modules "iso_fortran_env" } }