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]

RFC: patch to add ISO_FORTRAN_ENV intrinsic module


Hi all,

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


Of course, any other comments are welcome!


FX

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]