OSDN Git Service

2010-04-06 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 6 Apr 2010 17:58:50 +0000 (17:58 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 00:46:17 +0000 (09:46 +0900)
        PR fortran/18918
        * iso-fortran-env.def: Add the integer parameters
        * atomic_int_kind,
        atomic_logical_kind, iostat_inquire_internal_unit, stat_locked,
        stat_locked_other_image, stat_stopped_image and stat_unlocked of
        Fortran 2008.
        * intrinsic.texi (iso_fortran_env): Ditto.
        * libgfortran.h (libgfortran_stat_codes): New enum.
        * module.c (use_iso_fortran_env_module): Honour -std= when
        * loading
        constants from the intrinsic module.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/iso_fortran_env_5.f90: New test.
        * gfortran.dg/iso_fortran_env_6.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158011 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/intrinsic.texi
gcc/fortran/module.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/iso_fortran_env_6.f90

index 8af3668..f68a6ca 100644 (file)
@@ -1,5 +1,17 @@
 2010-04-06  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/18918
+       * iso-fortran-env.def: Add the integer parameters atomic_int_kind,
+       atomic_logical_kind, iostat_inquire_internal_unit, stat_locked,
+       stat_locked_other_image, stat_stopped_image and stat_unlocked of
+       Fortran 2008.
+       * intrinsic.texi (iso_fortran_env): Ditto.
+       * libgfortran.h (libgfortran_stat_codes): New enum.
+       * module.c (use_iso_fortran_env_module): Honour -std= when loading
+       constants from the intrinsic module.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/39997
        * intrinsic.c (add_functions): Add num_images.
        * decl.c (gfc_match_end): Handle END CRITICAL.
index 52992ba..4439464 100644 (file)
@@ -11281,14 +11281,21 @@ Fortran 95 elemental function: @ref{IEOR}
 @section @code{ISO_FORTRAN_ENV}
 @table @asis
 @item @emph{Standard}:
-Fortran 2003 and later; @code{INT8}, @code{INT16}, @code{INT32}, @code{INT64},
-@code{REAL32}, @code{REAL64}, @code{REAL128} are Fortran 2008 or later
+Fortran 2003 and later, except when otherwise noted
 @end table
 
 The @code{ISO_FORTRAN_ENV} module provides the following scalar default-integer
 named constants:
 
 @table @asis
+@item @code{ATOMIC_INT_KIND}:
+Default-kind integer constant to be used as kind parameter when defining
+integer variables used in atomic operations. (Fortran 2008 or later.)
+
+@item @code{ATOMIC_LOGICAL_KIND}:
+Default-kind integer constant to be used as kind parameter when defining
+logical variables used in atomic operations. (Fortran 2008 or later.)
+
 @item @code{CHARACTER_STORAGE_SIZE}:
 Size in bits of the character storage unit.
 
@@ -11302,10 +11309,10 @@ Size in bits of the file-storage unit.
 Identifies the preconnected unit identified by the asterisk
 (@code{*}) in @code{READ} statement.
 
-@item @code{INT8}, @code{INT16}, @code{INT32}, @code{INT64}
+@item @code{INT8}, @code{INT16}, @code{INT32}, @code{INT64}:
 Kind type parameters to specify an INTEGER type with a storage
 size of 16, 32, and 64 bits. It is negative if a target platform
-does not support the particular kind.
+does not support the particular kind. (Fortran 2008 or later.)
 
 @item @code{IOSTAT_END}:
 The value assigned to the variable passed to the IOSTAT= specifier of
@@ -11315,6 +11322,11 @@ an input/output statement if an end-of-file condition occurred.
 The value assigned to the variable passed to the IOSTAT= specifier of
 an input/output statement if an end-of-record condition occurred.
 
+@item @code{IOSTAT_INQUIRE_INTERNAL_UNIT}:
+Scalar default-integer constant, used by @code{INQUIRE} for the
+IOSTAT= specifier to denote an that a unit number identifies an
+internal unit. (Fortran 2008 or later.)
+
 @item @code{NUMERIC_STORAGE_SIZE}:
 The size in bits of the numeric storage unit.
 
@@ -11322,10 +11334,29 @@ The size in bits of the numeric storage unit.
 Identifies the preconnected unit identified by the asterisk
 (@code{*}) in @code{WRITE} statement.
 
-@item @code{REAL32}, @code{REAL64}, @code{REAL128}
+@item @code{REAL32}, @code{REAL64}, @code{REAL128}:
 Kind type parameters to specify a REAL type with a storage
 size of 32, 64, and 128 bits. It is negative if a target platform
-does not support the particular kind.
+does not support the particular kind. (Fortran 2008 or later.)
+
+@item @code{STAT_LOCKED}:
+Scalar default-integer constant used as STAT= return value by @code{LOCK} to
+denote that the lock variable is locked by the executing image. (Fortran 2008
+or later.)
+
+@item @code{STAT_LOCKED_OTHER_IMAGE}:
+Scalar default-integer constant used as STAT= return value by @code{UNLOCK} to
+denote that the lock variable is locked by another image. (Fortran 2008 or
+later.)
+
+@item @code{STAT_STOPPED_IMAGE}:
+Positive, scalar default-integer constant used as STAT= return value if the
+argument in the statement requires synchronisation with an image, which has
+initiated the termination of the execution. (Fortran 2008 or later.)
+
+@item @code{STAT_UNLOCKED}:
+Scalar default-integer constant used as STAT= return value by @code{UNLOCK} to
+denote that the lock variable is unlocked. (Fortran 2008 or later.)
 @end table
 
 
index a419d6b..666fd84 100644 (file)
@@ -73,13 +73,12 @@ along with GCC; see the file COPYING3.  If not see
 #include "match.h"
 #include "parse.h" /* FIXME */
 #include "md5.h"
-#include "constructor.h"
 
 #define MODULE_EXTENSION ".mod"
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "5"
+#define MOD_VERSION "4"
 
 
 /* Structure that describes a position within a module file.  */
@@ -1673,8 +1672,7 @@ typedef enum
   AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
   AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
-  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
-  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB
+  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS
 }
 ab_attribute;
 
@@ -1683,7 +1681,6 @@ static const mstring attr_bits[] =
     minit ("ALLOCATABLE", AB_ALLOCATABLE),
     minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
     minit ("DIMENSION", AB_DIMENSION),
-    minit ("CODIMENSION", AB_CODIMENSION),
     minit ("EXTERNAL", AB_EXTERNAL),
     minit ("INTRINSIC", AB_INTRINSIC),
     minit ("OPTIONAL", AB_OPTIONAL),
@@ -1711,7 +1708,6 @@ static const mstring attr_bits[] =
     minit ("IS_ISO_C", AB_IS_ISO_C),
     minit ("VALUE", AB_VALUE),
     minit ("ALLOC_COMP", AB_ALLOC_COMP),
-    minit ("COARRAY_COMP", AB_COARRAY_COMP),
     minit ("POINTER_COMP", AB_POINTER_COMP),
     minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
     minit ("ZERO_COMP", AB_ZERO_COMP),
@@ -1720,8 +1716,6 @@ static const mstring attr_bits[] =
     minit ("IS_CLASS", AB_IS_CLASS),
     minit ("PROCEDURE", AB_PROCEDURE),
     minit ("PROC_POINTER", AB_PROC_POINTER),
-    minit ("VTYPE", AB_VTYPE),
-    minit ("VTAB", AB_VTAB),
     minit (NULL, -1)
 };
 
@@ -1804,8 +1798,6 @@ mio_symbol_attribute (symbol_attribute *attr)
        MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits);
       if (attr->dimension)
        MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
-      if (attr->codimension)
-       MIO_NAME (ab_attribute) (AB_CODIMENSION, attr_bits);
       if (attr->external)
        MIO_NAME (ab_attribute) (AB_EXTERNAL, attr_bits);
       if (attr->intrinsic)
@@ -1872,8 +1864,6 @@ mio_symbol_attribute (symbol_attribute *attr)
        MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits);
       if (attr->private_comp)
        MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
-      if (attr->coarray_comp)
-       MIO_NAME (ab_attribute) (AB_COARRAY_COMP, attr_bits);
       if (attr->zero_comp)
        MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits);
       if (attr->is_class)
@@ -1882,10 +1872,6 @@ mio_symbol_attribute (symbol_attribute *attr)
        MIO_NAME (ab_attribute) (AB_PROCEDURE, attr_bits);
       if (attr->proc_pointer)
        MIO_NAME (ab_attribute) (AB_PROC_POINTER, attr_bits);
-      if (attr->vtype)
-       MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
-      if (attr->vtab)
-       MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
 
       mio_rparen ();
 
@@ -1911,9 +1897,6 @@ mio_symbol_attribute (symbol_attribute *attr)
            case AB_DIMENSION:
              attr->dimension = 1;
              break;
-           case AB_CODIMENSION:
-             attr->codimension = 1;
-             break;
            case AB_EXTERNAL:
              attr->external = 1;
              break;
@@ -2001,9 +1984,6 @@ mio_symbol_attribute (symbol_attribute *attr)
            case AB_ALLOC_COMP:
              attr->alloc_comp = 1;
              break;
-           case AB_COARRAY_COMP:
-             attr->coarray_comp = 1;
-             break;
            case AB_POINTER_COMP:
              attr->pointer_comp = 1;
              break;
@@ -2022,12 +2002,6 @@ mio_symbol_attribute (symbol_attribute *attr)
            case AB_PROC_POINTER:
              attr->proc_pointer = 1;
              break;
-           case AB_VTYPE:
-             attr->vtype = 1;
-             break;
-           case AB_VTAB:
-             attr->vtab = 1;
-             break;
            }
        }
     }
@@ -2157,10 +2131,9 @@ mio_array_spec (gfc_array_spec **asp)
     }
 
   mio_integer (&as->rank);
-  mio_integer (&as->corank);
   as->type = MIO_NAME (array_type) (as->type, array_spec_types);
 
-  for (i = 0; i < as->rank + as->corank; i++)
+  for (i = 0; i < as->rank; i++)
     {
       mio_expr (&as->lower[i]);
       mio_expr (&as->upper[i]);
@@ -2641,15 +2614,15 @@ done:
 
 
 static void
-mio_constructor (gfc_constructor_base *cp)
+mio_constructor (gfc_constructor **cp)
 {
-  gfc_constructor *c;
+  gfc_constructor *c, *tail;
 
   mio_lparen ();
 
   if (iomode == IO_OUTPUT)
     {
-      for (c = gfc_constructor_first (*cp); c; c = gfc_constructor_next (c))
+      for (c = *cp; c; c = c->next)
        {
          mio_lparen ();
          mio_expr (&c->expr);
@@ -2659,9 +2632,19 @@ mio_constructor (gfc_constructor_base *cp)
     }
   else
     {
+      *cp = NULL;
+      tail = NULL;
+
       while (peek_atom () != ATOM_RPAREN)
        {
-         c = gfc_constructor_append_expr (cp, NULL, NULL);
+         c = gfc_get_constructor ();
+
+         if (tail == NULL)
+           *cp = c;
+         else
+           tail->next = c;
+
+         tail = c;
 
          mio_lparen ();
          mio_expr (&c->expr);
@@ -4213,9 +4196,6 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info)
   if (st_sym == rsym)
     return false;
 
-  if (st_sym->attr.vtab || st_sym->attr.vtype)
-    return false;
-
   /* If the existing symbol is generic from a different module and
      the new symbol is generic there can be no ambiguity.  */
   if (st_sym->attr.generic
@@ -5349,7 +5329,7 @@ create_int_parameter (const char *name, int value, const char *modname,
   sym->attr.flavor = FL_PARAMETER;
   sym->ts.type = BT_INTEGER;
   sym->ts.kind = gfc_default_integer_kind;
-  sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL, value);
+  sym->value = gfc_int_expr (value);
   sym->attr.use_assoc = 1;
   sym->from_intmod = module;
   sym->intmod_sym_id = id;
@@ -5437,6 +5417,9 @@ use_iso_fortran_env_module (void)
        {
          local_name = NULL;
 
+         if ((gfc_option.allow_std & symbol[i].standard) == 0)
+           break;
+
          for (u = gfc_rename_list; u; u = u->next)
            {
              if (strcmp (symbol[i].name, u->use_name) == 0)
@@ -5447,13 +5430,6 @@ use_iso_fortran_env_module (void)
                }
            }
 
-         if (u && gfc_notify_std (symbol[i].standard, "The symbol '%s', "
-                                  "referrenced at %C, is not in the selected "
-                                  "standard", symbol[i].name) == FAILURE)
-           continue;
-         else if ((gfc_option.allow_std & symbol[i].standard) == 0)
-           continue;
-
          if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
              && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
            gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
index a65ba45..4053293 100644 (file)
@@ -1,5 +1,11 @@
 2010-04-06  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/18918
+       * gfortran.dg/iso_fortran_env_5.f90: New test.
+       * gfortran.dg/iso_fortran_env_6.f90: New test.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/39997
        * gfortran.dg/coarray_1.f90: New test.
        * gfortran.dg/coarray_2.f90: New test.
index 0f5aedf..951e138 100644 (file)
@@ -10,8 +10,6 @@ implicit none
 integer(kind=ATOMIC_INT_KIND) :: atomic_int ! { dg-error "has no IMPLICIT type" }
 logical(kind=ATOMIC_LOGICAL_KIND) :: atomic_bool ! { dg-error "has no IMPLICIT type" }
 
-print *, OUTPUT_UNIT
-
 if (IOSTAT_INQUIRE_INTERNAL_UNIT <= 0) call abort() ! { dg-error "has no IMPLICIT type" }
 print *,STAT_STOPPED_IMAGE ! { dg-error "has no IMPLICIT type" }
 print *, STAT_LOCKED_OTHER_IMAGE ! { dg-error "has no IMPLICIT type" }
@@ -20,7 +18,6 @@ print *, STAT_UNLOCKED ! { dg-error "has no IMPLICIT type" }
 end
 
 module m
-USE iso_fortran_env, only: INPUT_UNIT
 USE iso_fortran_env, only: ATOMIC_INT_KIND ! { dg-error "is not in the selected standard" }
 implicit none
 end module m
@@ -31,6 +28,6 @@ implicit none
 end module m2
 
 module m3
-USE iso_fortran_env, foo => IOSTAT_INQUIRE_INTERNAL_UNIT ! { dg-error "not in the selected standard" }
+USE iso_fortran_env, foo => IOSTAT_INQUIRE_INTERNAL_UNIT ! { dg-error "not found" }
 implicit none
 end module m3