This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch,fortran] Revamp type enumerators
- From: Jerry DeLisle <jvdelisle at frontier dot com>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 16 Oct 2010 23:42:31 -0700
- Subject: [patch,fortran] Revamp type enumerators
Hi all,
This patch gets rid of the GFC_DTYPE_X enumerators (dtype) used in the IO
Library and replaces this with the BT_X enumerators (bt) so that they do not
have to be trasnslated on the fly at runtime with switch statements.
The change ends up rippling around, but with this patch there is now one place
where the BT_X enumerators are defined for both the FE and runtime libraries.
The definition is placed in gcc/fortran/libgfortran.h which already contains
other common definitions. (I will also be putting in the same file a common
defintion for format tokens later).
Regression tested on x86-64-linux-gnu.
OK for trunk?
Regards,
Jerry
2010-10-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* gfortran.h: Remove definition of bt enumerator.
* libgfortran.h: Add bt enumerator type alighned with defintion.
Remove the dtype enumerator, no longer used.
previously given in libgfortran/io.h
* trans-types.c: Use new bt enumerator.
* trans-io.c: Likewise.
2010-10-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* io/io.h: Remove definition of the BT enumerator.
* libgfortran.h: Replace GFC_DTYPE enumerator with BT.
* intrinsics/iso_c_generated_procs.c: Likewise
* intrinsics/date_and_time.c: Likewise.
* intrinsics/iso_c_binding.c: Likewise.
* io/list_read.c: Likewise.
* io/transfer.c: Likewise.
* io/write.c: Likewise.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 165560)
+++ gcc/fortran/gfortran.h (working copy)
@@ -139,14 +139,6 @@ typedef enum
{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
gfc_source_form;
-/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
- can take any arg with the pointer attribute as a param. */
-typedef enum
-{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER,
- BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
-}
-bt;
-
/* Expression node types. */
typedef enum
{ EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (revision 165560)
+++ gcc/fortran/libgfortran.h (working copy)
@@ -122,16 +122,11 @@ libgfortran_stat_codes;
#define GFC_DTYPE_TYPE_MASK 0x38
#define GFC_DTYPE_SIZE_SHIFT 6
+/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
+ can take any arg with the pointer attribute as a param. These are also
+ used in the run-time library for IO. */
typedef enum
-{
- GFC_DTYPE_UNKNOWN = 0,
- GFC_DTYPE_INTEGER,
- /* TODO: recognize logical types. */
- GFC_DTYPE_LOGICAL,
- GFC_DTYPE_REAL,
- GFC_DTYPE_COMPLEX,
- GFC_DTYPE_DERIVED,
- GFC_DTYPE_CHARACTER
+{ BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL, BT_COMPLEX,
+ BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
}
-dtype;
-
+bt;
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c (revision 165560)
+++ gcc/fortran/trans-types.c (working copy)
@@ -1319,28 +1319,28 @@ gfc_get_dtype (tree type)
switch (TREE_CODE (etype))
{
case INTEGER_TYPE:
- n = GFC_DTYPE_INTEGER;
+ n = BT_INTEGER;
break;
case BOOLEAN_TYPE:
- n = GFC_DTYPE_LOGICAL;
+ n = BT_LOGICAL;
break;
case REAL_TYPE:
- n = GFC_DTYPE_REAL;
+ n = BT_REAL;
break;
case COMPLEX_TYPE:
- n = GFC_DTYPE_COMPLEX;
+ n = BT_COMPLEX;
break;
/* We will never have arrays of arrays. */
case RECORD_TYPE:
- n = GFC_DTYPE_DERIVED;
+ n = BT_DERIVED;
break;
case ARRAY_TYPE:
- n = GFC_DTYPE_CHARACTER;
+ n = BT_CHARACTER;
break;
default:
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (revision 165560)
+++ gcc/fortran/trans-io.c (working copy)
@@ -1572,33 +1572,7 @@ transfer_namelist_element (stmtblock_t * block, co
}
else
{
- itype = GFC_DTYPE_UNKNOWN;
-
- switch (ts->type)
-
- {
- case BT_INTEGER:
- itype = GFC_DTYPE_INTEGER;
- break;
- case BT_LOGICAL:
- itype = GFC_DTYPE_LOGICAL;
- break;
- case BT_REAL:
- itype = GFC_DTYPE_REAL;
- break;
- case BT_COMPLEX:
- itype = GFC_DTYPE_COMPLEX;
- break;
- case BT_DERIVED:
- itype = GFC_DTYPE_DERIVED;
- break;
- case BT_CHARACTER:
- itype = GFC_DTYPE_CHARACTER;
- break;
- default:
- gcc_unreachable ();
- }
-
+ itype = ts->type;
dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
}
Index: libgfortran/intrinsics/iso_c_generated_procs.c
===================================================================
--- libgfortran/intrinsics/iso_c_generated_procs.c (revision 165560)
+++ libgfortran/intrinsics/iso_c_generated_procs.c (working copy)
@@ -139,7 +139,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *c_ptr
{
/* Here we have an integer(kind=1). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_INTEGER,
+ (int) BT_INTEGER,
(int) sizeof (GFC_INTEGER_1));
}
#endif
@@ -162,7 +162,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *c_ptr
{
/* Here we have an integer(kind=2). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_INTEGER,
+ (int) BT_INTEGER,
(int) sizeof (GFC_INTEGER_2));
}
#endif
@@ -181,7 +181,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *c_ptr
{
/* Here we have an integer(kind=4). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_INTEGER,
+ (int) BT_INTEGER,
(int) sizeof (GFC_INTEGER_4));
}
#endif
@@ -200,7 +200,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *c_ptr
{
/* Here we have an integer(kind=8). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_INTEGER,
+ (int) BT_INTEGER,
(int) sizeof (GFC_INTEGER_8));
}
#endif
@@ -223,7 +223,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *c_pt
{
/* Here we have an integer(kind=16). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_INTEGER,
+ (int) BT_INTEGER,
(int) sizeof (GFC_INTEGER_16));
}
#endif
@@ -242,7 +242,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *c_ptr
{
/* Here we have an real(kind=4). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_REAL,
+ (int) BT_REAL,
(int) sizeof (GFC_REAL_4));
}
#endif
@@ -261,7 +261,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *c_ptr
{
/* Here we have an real(kind=8). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_REAL,
+ (int) BT_REAL,
(int) sizeof (GFC_REAL_8));
}
#endif
@@ -280,7 +280,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *c_pt
{
/* Here we have an real(kind=10). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_REAL,
+ (int) BT_REAL,
(int) sizeof (GFC_REAL_10));
}
#endif
@@ -299,7 +299,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *c_pt
{
/* Here we have an real(kind=16). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_REAL,
+ (int) BT_REAL,
(int) sizeof (GFC_REAL_16));
}
#endif
@@ -318,7 +318,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *c_ptr
{
/* Here we have an complex(kind=4). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_COMPLEX,
+ (int) BT_COMPLEX,
(int) sizeof (GFC_COMPLEX_4));
}
#endif
@@ -337,7 +337,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *c_ptr
{
/* Here we have an complex(kind=8). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_COMPLEX,
+ (int) BT_COMPLEX,
(int) sizeof (GFC_COMPLEX_8));
}
#endif
@@ -356,7 +356,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *c_pt
{
/* Here we have an complex(kind=10). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_COMPLEX,
+ (int) BT_COMPLEX,
(int) sizeof (GFC_COMPLEX_10));
}
#endif
@@ -375,7 +375,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *c_pt
{
/* Here we have an complex(kind=16). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_COMPLEX,
+ (int) BT_COMPLEX,
(int) sizeof (GFC_COMPLEX_16));
}
#endif
@@ -392,7 +392,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *c_ptr
{
/* Here we have a character string of len=1. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_CHARACTER,
+ (int) BT_CHARACTER,
(int) sizeof (char));
}
#endif
@@ -409,7 +409,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *c_ptr
{
/* Here we have a logical of kind=1. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_LOGICAL,
+ (int) BT_LOGICAL,
(int) sizeof (GFC_LOGICAL_1));
}
#endif
@@ -426,7 +426,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *c_ptr
{
/* Here we have a logical of kind=2. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_LOGICAL,
+ (int) BT_LOGICAL,
(int) sizeof (GFC_LOGICAL_2));
}
#endif
@@ -443,7 +443,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *c_ptr
{
/* Here we have a logical of kind=4. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_LOGICAL,
+ (int) BT_LOGICAL,
(int) sizeof (GFC_LOGICAL_4));
}
#endif
@@ -460,7 +460,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *c_ptr
{
/* Here we have a logical of kind=8. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
- (int) GFC_DTYPE_LOGICAL,
+ (int) BT_LOGICAL,
(int) sizeof (GFC_LOGICAL_8));
}
#endif
Index: libgfortran/intrinsics/date_and_time.c
===================================================================
--- libgfortran/intrinsics/date_and_time.c (revision 165560)
+++ libgfortran/intrinsics/date_and_time.c (working copy)
@@ -349,7 +349,7 @@ secnds (GFC_REAL_4 *x)
/* Make the INTEGER*4 array for passing to date_and_time. */
gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4));
avalues->data = &values[0];
- GFC_DESCRIPTOR_DTYPE (avalues) = ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT)
+ GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT)
& GFC_DTYPE_TYPE_MASK) +
(4 << GFC_DTYPE_SIZE_SHIFT);
Index: libgfortran/intrinsics/iso_c_binding.c
===================================================================
--- libgfortran/intrinsics/iso_c_binding.c (revision 165560)
+++ libgfortran/intrinsics/iso_c_binding.c (working copy)
@@ -65,7 +65,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in
/* Put in the element size. */
f_ptr_out->dtype = f_ptr_out->dtype | (elemSize << GFC_DTYPE_SIZE_SHIFT);
- /* Set the data type (e.g., GFC_DTYPE_INTEGER). */
+ /* Set the data type (e.g., BT_INTEGER). */
f_ptr_out->dtype = f_ptr_out->dtype | (type << GFC_DTYPE_TYPE_SHIFT);
}
@@ -184,6 +184,6 @@ ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr
{
f_ptr_out->dtype = f_ptr_out->dtype & (~GFC_DTYPE_TYPE_MASK);
f_ptr_out->dtype = f_ptr_out->dtype
- | (GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT);
+ | (BT_DERIVED << GFC_DTYPE_TYPE_SHIFT);
}
}
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h (revision 165560)
+++ libgfortran/libgfortran.h (working copy)
@@ -418,68 +418,68 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS,
#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
-#define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_LOGICAL_16
-#define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_REAL_10
-#define GFC_DTYPE_REAL_10 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
#endif
#ifdef HAVE_GFC_REAL_16
-#define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_COMPLEX_10
-#define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
#endif
#ifdef HAVE_GFC_COMPLEX_16
-#define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
Index: libgfortran/io/list_read.c
===================================================================
--- libgfortran/io/list_read.c (revision 165560)
+++ libgfortran/io/list_read.c (working copy)
@@ -1668,7 +1668,7 @@ check_type (st_parameter_dt *dtp, bt type, int len
{
char message[100];
- if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type)
+ if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
{
sprintf (message, "Read type %s where %s was expected for item %d",
type_name (dtp->u.p.saved_type), type_name (type),
@@ -1678,7 +1678,7 @@ check_type (st_parameter_dt *dtp, bt type, int len
return 1;
}
- if (dtp->u.p.saved_type == BT_NULL || dtp->u.p.saved_type == BT_CHARACTER)
+ if (dtp->u.p.saved_type == BT_UNKNOWN || dtp->u.p.saved_type == BT_CHARACTER)
return 0;
if (dtp->u.p.saved_length != len)
@@ -1771,7 +1771,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp,
finish_separator (dtp);
}
- dtp->u.p.saved_type = BT_NULL;
+ dtp->u.p.saved_type = BT_UNKNOWN;
dtp->u.p.repeat_count = 1;
}
@@ -1802,7 +1802,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp,
internal_error (&dtp->common, "Bad type for list read");
}
- if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_NULL)
+ if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_UNKNOWN)
dtp->u.p.saved_length = size;
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
@@ -1853,8 +1853,11 @@ list_formatted_read_scalar (st_parameter_dt *dtp,
}
break;
- case BT_NULL:
+ case BT_UNKNOWN:
break;
+
+ default:
+ internal_error (&dtp->common, "Bad type for list read");
}
if (--dtp->u.p.repeat_count <= 0)
@@ -2099,7 +2102,6 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
if (indx == 0)
{
memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
-
/* If -std=f95/2003 or an array section is specified,
do not allow excess data to be processed. */
if (is_array_section == 1
@@ -2362,20 +2364,20 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info
len = nl->len;
switch (nl->type)
{
- case GFC_DTYPE_INTEGER:
- case GFC_DTYPE_LOGICAL:
+ case BT_INTEGER:
+ case BT_LOGICAL:
dlen = len;
break;
- case GFC_DTYPE_REAL:
+ case BT_REAL:
dlen = size_from_real_kind (len);
break;
- case GFC_DTYPE_COMPLEX:
+ case BT_COMPLEX:
dlen = size_from_complex_kind (len);
break;
- case GFC_DTYPE_CHARACTER:
+ case BT_CHARACTER:
dlen = chigh ? (chigh - clow + 1) : nl->string_length;
break;
@@ -2407,40 +2409,37 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info
if (dtp->u.p.input_complete)
return SUCCESS;
- /* BT_NULL (equivalent to GFC_DTYPE_UNKNOWN) falls through
- for nulls and is detected at default: of switch block. */
-
- dtp->u.p.saved_type = BT_NULL;
+ dtp->u.p.saved_type = BT_UNKNOWN;
free_saved (dtp);
switch (nl->type)
{
- case GFC_DTYPE_INTEGER:
+ case BT_INTEGER:
read_integer (dtp, len);
break;
- case GFC_DTYPE_LOGICAL:
+ case BT_LOGICAL:
read_logical (dtp, len);
break;
- case GFC_DTYPE_CHARACTER:
+ case BT_CHARACTER:
read_character (dtp, len);
break;
- case GFC_DTYPE_REAL:
+ case BT_REAL:
/* Need to copy data back from the real location to the temp in order
to handle nml reads into arrays. */
read_real (dtp, pdata, len);
memcpy (dtp->u.p.value, pdata, dlen);
break;
- case GFC_DTYPE_COMPLEX:
+ case BT_COMPLEX:
/* Same as for REAL, copy back to temp. */
read_complex (dtp, pdata, len, dlen);
memcpy (dtp->u.p.value, pdata, dlen);
break;
- case GFC_DTYPE_DERIVED:
+ case BT_DERIVED:
obj_name_len = strlen (nl->var_name) + 1;
obj_name = get_mem (obj_name_len+1);
memcpy (obj_name, nl->var_name, obj_name_len-1);
@@ -2500,15 +2499,12 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info
return SUCCESS;
}
- if (dtp->u.p.saved_type == BT_NULL)
+ if (dtp->u.p.saved_type == BT_UNKNOWN)
{
dtp->u.p.expanded_read = 0;
goto incr_idx;
}
- /* Note the switch from GFC_DTYPE_type to BT_type at this point.
- This comes about because the read functions return BT_types. */
-
switch (dtp->u.p.saved_type)
{
@@ -2750,7 +2746,7 @@ get_name:
if (c == '%')
{
- if (nl->type != GFC_DTYPE_DERIVED)
+ if (nl->type != BT_DERIVED)
{
snprintf (nml_err_msg, nml_err_msg_size,
"Attempt to get derived component for %s", nl->var_name);
@@ -2774,7 +2770,7 @@ get_name:
clow = 1;
chigh = 0;
- if (c == '(' && nl->type == GFC_DTYPE_CHARACTER)
+ if (c == '(' && nl->type == BT_CHARACTER)
{
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
@@ -2852,7 +2848,7 @@ get_name:
namelist_info if we have parsed a qualified derived type
component. */
- if (nl->type == GFC_DTYPE_DERIVED)
+ if (nl->type == BT_DERIVED)
nml_touch_nodes (nl);
if (first_nl)
@@ -2870,6 +2866,11 @@ get_name:
clow, chigh) == FAILURE)
goto nml_err_ret;
+ /* At this point we have a good read. Is the user trying to do an
+ extended read, providing more data to read then specified in an array
+ qualifier? We decide by looking ahead to see if the next item is an object
+ name, if not we try to use it as data. */
+
return SUCCESS;
nml_err_ret:
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h (revision 165560)
+++ libgfortran/io/io.h (working copy)
@@ -34,14 +34,6 @@ see the files COPYING3 and COPYING.RUNTIME respect
#include <setjmp.h>
#include <gthr.h>
-/* Basic types used in data transfers. */
-
-typedef enum
-{ BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
- BT_COMPLEX
-}
-bt;
-
/* Forward declarations. */
struct st_parameter_dt;
typedef struct stream stream;
@@ -115,7 +107,7 @@ format_hash_entry;
typedef struct namelist_type
{
/* Object type, stored as GFC_DTYPE_xxxx. */
- dtype type;
+ bt type;
/* Object name. */
char * var_name;
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c (revision 165560)
+++ libgfortran/io/transfer.c (working copy)
@@ -1977,7 +1977,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_ch
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type stride[GFC_MAX_DIMENSIONS];
- index_type stride0, rank, size, type, n;
+ index_type stride0, rank, size, n;
size_t tsize;
char *data;
bt iotype;
@@ -1985,40 +1985,9 @@ transfer_array (st_parameter_dt *dtp, gfc_array_ch
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
return;
- type = GFC_DESCRIPTOR_TYPE (desc);
- size = GFC_DESCRIPTOR_SIZE (desc);
+ iotype = (bt) GFC_DESCRIPTOR_TYPE (desc);
+ size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc);
- /* FIXME: What a kludge: Array descriptors and the IO library use
- different enums for types. */
- switch (type)
- {
- case GFC_DTYPE_UNKNOWN:
- iotype = BT_NULL; /* Is this correct? */
- break;
- case GFC_DTYPE_INTEGER:
- iotype = BT_INTEGER;
- break;
- case GFC_DTYPE_LOGICAL:
- iotype = BT_LOGICAL;
- break;
- case GFC_DTYPE_REAL:
- iotype = BT_REAL;
- break;
- case GFC_DTYPE_COMPLEX:
- iotype = BT_COMPLEX;
- break;
- case GFC_DTYPE_CHARACTER:
- iotype = BT_CHARACTER;
- size = charlen;
- break;
- case GFC_DTYPE_DERIVED:
- internal_error (&dtp->common,
- "Derived type I/O should have been handled via the frontend.");
- break;
- default:
- internal_error (&dtp->common, "transfer_array(): Bad type");
- }
-
rank = GFC_DESCRIPTOR_RANK (desc);
for (n = 0; n < rank; n++)
{
Index: libgfortran/io/write.c
===================================================================
--- libgfortran/io/write.c (revision 165560)
+++ libgfortran/io/write.c (working copy)
@@ -1705,7 +1705,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info
/* Write namelist variable names in upper case. If a derived type,
nothing is output. If a component, base and base_name are set. */
- if (obj->type != GFC_DTYPE_DERIVED)
+ if (obj->type != BT_DERIVED)
{
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
@@ -1739,15 +1739,15 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info
switch (obj->type)
{
- case GFC_DTYPE_REAL:
+ case BT_REAL:
obj_size = size_from_real_kind (len);
break;
- case GFC_DTYPE_COMPLEX:
+ case BT_COMPLEX:
obj_size = size_from_complex_kind (len);
break;
- case GFC_DTYPE_CHARACTER:
+ case BT_CHARACTER:
obj_size = obj->string_length;
break;
@@ -1783,7 +1783,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info
/* Check for repeat counts of intrinsic types. */
if ((elem_ctr < (nelem - 1)) &&
- (obj->type != GFC_DTYPE_DERIVED) &&
+ (obj->type != BT_DERIVED) &&
!memcmp (p, (void*)(p + obj_size ), obj_size ))
{
rep_ctr++;
@@ -1808,15 +1808,15 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info
switch (obj->type)
{
- case GFC_DTYPE_INTEGER:
+ case BT_INTEGER:
write_integer (dtp, p, len);
break;
- case GFC_DTYPE_LOGICAL:
+ case BT_LOGICAL:
write_logical (dtp, p, len);
break;
- case GFC_DTYPE_CHARACTER:
+ case BT_CHARACTER:
tmp_delim = dtp->u.p.current_unit->delim_status;
if (dtp->u.p.nml_delim == '"')
dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
@@ -1826,17 +1826,17 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info
dtp->u.p.current_unit->delim_status = tmp_delim;
break;
- case GFC_DTYPE_REAL:
+ case BT_REAL:
write_real (dtp, p, len);
break;
- case GFC_DTYPE_COMPLEX:
+ case BT_COMPLEX:
dtp->u.p.no_leading_blank = 0;
num++;
write_complex (dtp, p, len, obj_size);
break;
- case GFC_DTYPE_DERIVED:
+ case BT_DERIVED:
/* To treat a derived type, we need to build two strings:
ext_name = the name, including qualifiers that prepends