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 118930) +++ 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 118930) +++ gcc/fortran/module.c (working copy) @@ -498,24 +498,24 @@ if (gfc_match (" , ") == MATCH_YES) { if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) - { - if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module " - "nature in USE statement at %C") == FAILURE) - return MATCH_ERROR; + { + if (gfc_notify_std (GFC_STD_F2003, "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 shall " - "be either INTRINSIC or NON_INTRINSIC"); - 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 shall " + "be either INTRINSIC or NON_INTRINSIC"); + return MATCH_ERROR; + } + } } else { @@ -538,11 +538,11 @@ return MATCH_ERROR; if (m != MATCH_YES) - { - m = gfc_match ("% "); - if (m != MATCH_YES) - return m; - } + { + m = gfc_match ("% "); + if (m != MATCH_YES) + return m; + } } m = gfc_match_name (module_name); @@ -3843,6 +3843,138 @@ } +/* 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; + + mstring symbol[] = { +#define NAMED_INTCST(a,b,c) minit(b,0), +#include "iso-fortran-env.def" +#undef NAMED_INTCST + minit (NULL, -1234) }; + + i = 0; +#define NAMED_INTCST(a,b,c) symbol[i++].tag = c; +#include "iso-fortran-env.def" +#undef NAMED_INTCST + + /* 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 @@ -3851,6 +3983,7 @@ char *filename; gfc_state_data *p; int c, line, start; + gfc_symtree *mod_symtree; filename = (char *) alloca(strlen(module_name) + strlen(MODULE_EXTENSION) + 1); @@ -3867,7 +4000,6 @@ specified that the module is non-intrinsic. */ if (module_fp == NULL && !specified_nonint) { -#if 0 if (strcmp (module_name, "iso_fortran_env") == 0 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: " "ISO_FORTRAN_ENV intrinsic module at %C") != FAILURE) @@ -3875,7 +4007,6 @@ use_iso_fortran_env_module (); return; } -#endif module_fp = gfc_open_intrinsic_module (filename); @@ -3888,6 +4019,14 @@ 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 118930) +++ 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 118930) +++ gcc/fortran/resolve.c (working copy) @@ -6007,7 +6007,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/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_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/use_3.f90 (revision 118930) +++ gcc/testsuite/gfortran.dg/use_3.f90 (working copy) @@ -7,6 +7,6 @@ use, intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" } use, non_intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" } use, nonintrinsic :: iso_fortran_env ! { dg-error "shall be either INTRINSIC or NON_INTRINSIC" } - use, intrinsic :: iso_fortran_env ! { dg-error "Can't find an intrinsic module named" } + use, intrinsic :: iso_fortran_env end ! { dg-final { cleanup-modules "foo" } } 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" } }