===================================================================
@@ -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,
===================================================================
@@ -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;
===================================================================
@@ -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:
===================================================================
@@ -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);
}
===================================================================
@@ -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
===================================================================
@@ -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);
===================================================================
@@ -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);
}
}
===================================================================
@@ -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
===================================================================
@@ -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:
===================================================================
@@ -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;
===================================================================
@@ -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++)
{
===================================================================
@@ -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