Improve run-time diagnostic for "PRINT '(I1', 42":
* com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_,
which is now a macro (to avoid lots of changes to other code)
with new arg, ffecom_char_args_with_null_ being another new
macro to call same function with different value for new arg.
This function now appends a null byte to opCONTER expression
if the new arg is TRUE.
(ffecom_arg_ptr_to_expr): Support NULL length pointer.
* ste.c (ffeste_io_cilist_):
(ffeste_io_icilist_): Pass NULL length ptr for
FORMAT expression, so null byte gets appended where
feasible.
* target.c (ffetarget_character1):
(ffetarget_concatenate_character1):
(ffetarget_substr_character1):
(ffetarget_convert_character1_character1):
(ffetarget_convert_character1_hollerith):
(ffetarget_convert_character1_integer4):
(ffetarget_convert_character1_logical4):
(ffetarget_convert_character1_typeless):
(ffetarget_hollerith): Append extra phantom null byte as
part of FFETARGET-NULL-BYTE kludge.
Yes, even more patches from Craig :-)
From-SVN: r18187
This commit is contained in:
Craig Burley
Jeff Law
parent
99ce4a1111
commit
86fc7a6c5d
@ -29,6 +29,29 @@ Fri Jan 9 19:09:07 1998 Craig Burley <burley@gnu.org>
|
||||
|
||||
Tue Dec 23 14:58:04 1997 Craig Burley <burley@gnu.org>
|
||||
|
||||
Improve run-time diagnostic for "PRINT '(I1', 42":
|
||||
* com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_,
|
||||
which is now a macro (to avoid lots of changes to other code)
|
||||
with new arg, ffecom_char_args_with_null_ being another new
|
||||
macro to call same function with different value for new arg.
|
||||
This function now appends a null byte to opCONTER expression
|
||||
if the new arg is TRUE.
|
||||
(ffecom_arg_ptr_to_expr): Support NULL length pointer.
|
||||
* ste.c (ffeste_io_cilist_):
|
||||
(ffeste_io_icilist_): Pass NULL length ptr for
|
||||
FORMAT expression, so null byte gets appended where
|
||||
feasible.
|
||||
* target.c (ffetarget_character1):
|
||||
(ffetarget_concatenate_character1):
|
||||
(ffetarget_substr_character1):
|
||||
(ffetarget_convert_character1_character1):
|
||||
(ffetarget_convert_character1_hollerith):
|
||||
(ffetarget_convert_character1_integer4):
|
||||
(ffetarget_convert_character1_logical4):
|
||||
(ffetarget_convert_character1_typeless):
|
||||
(ffetarget_hollerith): Append extra phantom null byte as
|
||||
part of FFETARGET-NULL-BYTE kludge.
|
||||
|
||||
* intrin.c (ffeintrin_fulfill_generic): Don't generate
|
||||
FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic.
|
||||
|
||||
|
||||
96
gcc/f/com.c
96
gcc/f/com.c
@ -420,8 +420,8 @@ static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
|
||||
tree dest_tree, ffebld dest,
|
||||
bool *dest_used, tree callee_commons,
|
||||
bool scalar_args);
|
||||
static void ffecom_char_args_ (tree *xitem, tree *length,
|
||||
ffebld expr);
|
||||
static void ffecom_char_args_x_ (tree *xitem, tree *length,
|
||||
ffebld expr, bool with_null);
|
||||
static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
|
||||
static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
|
||||
static ffecomConcatList_
|
||||
@ -653,6 +653,9 @@ static char *ffecom_gfrt_argstring_[FFECOM_gfrt]
|
||||
#define ffecom_start_compstmt_ bison_rule_pushlevel_
|
||||
#define ffecom_end_compstmt_ bison_rule_compstmt_
|
||||
|
||||
#define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE)
|
||||
#define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE)
|
||||
|
||||
/* For each binding contour we allocate a binding_level structure
|
||||
* which records the names defined in that contour.
|
||||
* Contours include:
|
||||
@ -1646,36 +1649,46 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
|
||||
}
|
||||
#endif
|
||||
|
||||
/* ffecom_char_args_ -- Return ptr/length args for char subexpression
|
||||
/* ffecom_char_args_x_ -- Return ptr/length args for char subexpression
|
||||
|
||||
tree ptr_arg;
|
||||
tree length_arg;
|
||||
ffebld expr;
|
||||
ffecom_char_args_(&ptr_arg,&length_arg,expr);
|
||||
bool with_null;
|
||||
ffecom_char_args_x_(&ptr_arg,&length_arg,expr,with_null);
|
||||
|
||||
Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
|
||||
subexpressions by constructing the appropriate trees for the ptr-to-
|
||||
character-text and length-of-character-text arguments in a calling
|
||||
sequence. */
|
||||
sequence.
|
||||
|
||||
Note that if with_null is TRUE, and the expression is an opCONTER,
|
||||
a null byte is appended to the string. */
|
||||
|
||||
#if FFECOM_targetCURRENT == FFECOM_targetGCC
|
||||
static void
|
||||
ffecom_char_args_ (tree *xitem, tree *length, ffebld expr)
|
||||
ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
|
||||
{
|
||||
tree item;
|
||||
tree high;
|
||||
ffetargetCharacter1 val;
|
||||
ffetargetCharacterSize newlen;
|
||||
|
||||
switch (ffebld_op (expr))
|
||||
{
|
||||
case FFEBLD_opCONTER:
|
||||
val = ffebld_constant_character1 (ffebld_conter (expr));
|
||||
*length = build_int_2 (ffetarget_length_character1 (val), 0);
|
||||
newlen = ffetarget_length_character1 (val);
|
||||
if (with_null)
|
||||
{
|
||||
if (newlen != 0)
|
||||
++newlen; /* begin FFETARGET-NULL-KLUDGE. */
|
||||
}
|
||||
*length = build_int_2 (newlen, 0);
|
||||
TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
|
||||
high = build_int_2 (ffetarget_length_character1 (val),
|
||||
0);
|
||||
high = build_int_2 (newlen, 0);
|
||||
TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
|
||||
item = build_string (ffetarget_length_character1 (val),
|
||||
item = build_string (newlen, /* end FFETARGET-NULL-KLUDGE. */
|
||||
ffetarget_text_character1 (val));
|
||||
TREE_TYPE (item)
|
||||
= build_type_variant
|
||||
@ -10818,7 +10831,19 @@ ffecom_arg_expr (ffebld expr, tree *length)
|
||||
returns and sets the length return value to NULL_TREE. Otherwise
|
||||
generates code to evaluate the character expression, returns the proper
|
||||
pointer to the result, AND sets the length return value to a tree that
|
||||
specifies the length of the result. */
|
||||
specifies the length of the result.
|
||||
|
||||
If the length argument is NULL, this is a slightly special
|
||||
case of building a FORMAT expression, that is, an expression that
|
||||
will be used at run time without regard to length. For the current
|
||||
implementation, which uses the libf2c library, this means it is nice
|
||||
to append a null byte to the end of the expression, where feasible,
|
||||
to make sure any diagnostic about the FORMAT string terminates at
|
||||
some useful point.
|
||||
|
||||
For now, treat %REF(char-expr) as the same as char-expr with a NULL
|
||||
length argument. This might even be seen as a feature, if a null
|
||||
byte can always be appended. */
|
||||
|
||||
#if FFECOM_targetCURRENT == FFECOM_targetGCC
|
||||
tree
|
||||
@ -10828,7 +10853,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
tree ign_length;
|
||||
ffecomConcatList_ catlist;
|
||||
|
||||
*length = NULL_TREE;
|
||||
if (length != NULL)
|
||||
*length = NULL_TREE;
|
||||
|
||||
if (expr == NULL)
|
||||
return integer_zero_node;
|
||||
@ -10850,8 +10876,11 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
case FFEBLD_opPERCENT_REF:
|
||||
if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
|
||||
return ffecom_ptr_to_expr (ffebld_left (expr));
|
||||
ign_length = NULL_TREE;
|
||||
length = &ign_length;
|
||||
if (length != NULL)
|
||||
{
|
||||
ign_length = NULL_TREE;
|
||||
length = &ign_length;
|
||||
}
|
||||
expr = ffebld_left (expr);
|
||||
break;
|
||||
|
||||
@ -10877,7 +10906,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
}
|
||||
|
||||
#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
|
||||
if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
|
||||
if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
|
||||
&& (length != NULL))
|
||||
{ /* Pass Hollerith by descriptor. */
|
||||
ffetargetHollerith h;
|
||||
|
||||
@ -10900,14 +10930,21 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
switch (ffecom_concat_list_count_ (catlist))
|
||||
{
|
||||
case 0: /* Shouldn't happen, but in case it does... */
|
||||
*length = ffecom_f2c_ftnlen_zero_node;
|
||||
TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
|
||||
if (length != NULL)
|
||||
{
|
||||
*length = ffecom_f2c_ftnlen_zero_node;
|
||||
TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
|
||||
}
|
||||
ffecom_concat_list_kill_ (catlist);
|
||||
return null_pointer_node;
|
||||
|
||||
case 1: /* The (fairly) easy case. */
|
||||
ffecom_char_args_ (&item, length,
|
||||
ffecom_concat_list_expr_ (catlist, 0));
|
||||
if (length == NULL)
|
||||
ffecom_char_args_with_null_ (&item, &ign_length,
|
||||
ffecom_concat_list_expr_ (catlist, 0));
|
||||
else
|
||||
ffecom_char_args_ (&item, length,
|
||||
ffecom_concat_list_expr_ (catlist, 0));
|
||||
ffecom_concat_list_kill_ (catlist);
|
||||
assert (item != NULL_TREE);
|
||||
return item;
|
||||
@ -10943,8 +10980,13 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
|
||||
for (i = 0; i < count; ++i)
|
||||
{
|
||||
ffecom_char_args_ (&citem, &clength,
|
||||
ffecom_concat_list_expr_ (catlist, i));
|
||||
if ((i == count)
|
||||
&& (length == NULL))
|
||||
ffecom_char_args_with_null_ (&citem, &clength,
|
||||
ffecom_concat_list_expr_ (catlist, i));
|
||||
else
|
||||
ffecom_char_args_ (&citem, &clength,
|
||||
ffecom_concat_list_expr_ (catlist, i));
|
||||
if ((citem == error_mark_node)
|
||||
|| (clength == error_mark_node))
|
||||
{
|
||||
@ -10963,10 +11005,11 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
citem),
|
||||
items);
|
||||
clength = ffecom_save_tree (clength);
|
||||
known_length
|
||||
= ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
|
||||
known_length,
|
||||
clength);
|
||||
if (length != NULL)
|
||||
known_length
|
||||
= ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
|
||||
known_length,
|
||||
clength);
|
||||
lengths
|
||||
= ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
|
||||
ffecom_modify (void_type_node,
|
||||
@ -11015,7 +11058,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
|
||||
item,
|
||||
temporary);
|
||||
|
||||
*length = known_length;
|
||||
if (length != NULL)
|
||||
*length = known_length;
|
||||
}
|
||||
|
||||
ffecom_concat_list_kill_ (catlist);
|
||||
|
||||
@ -27,6 +27,26 @@ involve a combination of these elements.
|
||||
@heading In 0.5.22:
|
||||
@itemize @bullet
|
||||
@item
|
||||
@item
|
||||
Improve diagnostic messages from @code{libf2c}
|
||||
so it is more likely that the printing of the
|
||||
active format string is limited to the string,
|
||||
with no trailing garbage being printed.
|
||||
|
||||
(Unlike @code{f2c}, @code{g77} does not append
|
||||
a null byte to its compiled form of every
|
||||
format string specified via a @code{FORMAT} statement.
|
||||
However, @code{f2c} would exhibit the problem
|
||||
anyway for a statement like @samp{PRINT '(I)garbage', 1}
|
||||
by printing @samp{(I)garbage} as the format string.)
|
||||
|
||||
@item
|
||||
Improve compilation of FORMAT expressions so that
|
||||
a null byte is appended to the last operand if it
|
||||
is a constant.
|
||||
This provides a cleaner run-time diagnostic as provided
|
||||
by @code{libf2c} for statements like @samp{PRINT '(I1', 42}.
|
||||
|
||||
Fix @code{SIGNAL} intrinsic so it offers portable
|
||||
support for 64-bit systems (such as Digital Alphas
|
||||
running GNU/Linux).
|
||||
|
||||
@ -999,7 +999,6 @@ ffeste_io_cilist_ (bool have_err,
|
||||
int yes;
|
||||
tree field;
|
||||
tree inits, initn;
|
||||
tree ignore; /* We ignore the length of format! */
|
||||
bool constantp = TRUE;
|
||||
static tree errfield, unitfield, endfield, formatfield, recfield;
|
||||
tree errinit, unitinit, endinit, formatinit, recinit;
|
||||
@ -1086,7 +1085,7 @@ ffeste_io_cilist_ (bool have_err,
|
||||
break;
|
||||
|
||||
case FFESTV_formatCHAREXPR:
|
||||
formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
|
||||
formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
|
||||
if (TREE_CONSTANT (formatexp))
|
||||
{
|
||||
formatinit = formatexp;
|
||||
@ -1305,7 +1304,6 @@ ffeste_io_icilist_ (bool have_err,
|
||||
int yes;
|
||||
tree field;
|
||||
tree inits, initn;
|
||||
tree ignore; /* We ignore the length of format! */
|
||||
bool constantp = TRUE;
|
||||
static tree errfield, unitfield, endfield, formatfield, unitlenfield,
|
||||
unitnumfield;
|
||||
@ -1409,7 +1407,7 @@ ffeste_io_icilist_ (bool have_err,
|
||||
break;
|
||||
|
||||
case FFESTV_formatCHAREXPR:
|
||||
formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
|
||||
formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
|
||||
if (TREE_CONSTANT (formatexp))
|
||||
{
|
||||
formatinit = formatexp;
|
||||
|
||||
@ -280,6 +280,13 @@ ffetarget_align (ffetargetAlign *updated_alignment,
|
||||
return min_pad;
|
||||
}
|
||||
|
||||
/* Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
bool
|
||||
ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
|
||||
@ -290,8 +297,9 @@ ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
|
||||
val->text = NULL;
|
||||
else
|
||||
{
|
||||
val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length);
|
||||
val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length + 1);
|
||||
memcpy (val->text, ffelex_token_text (character), val->length);
|
||||
val->text[val->length] = '\0';
|
||||
}
|
||||
|
||||
return TRUE;
|
||||
@ -318,7 +326,12 @@ ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r)
|
||||
#endif
|
||||
/* ffetarget_concatenate_character1 -- Perform CONCAT op on two constants
|
||||
|
||||
Compare lengths, if equal then use memcmp. */
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
@ -331,11 +344,12 @@ ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len);
|
||||
res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len + 1);
|
||||
if (l.length != 0)
|
||||
memcpy (res->text, l.text, l.length);
|
||||
if (r.length != 0)
|
||||
memcpy (res->text + l.length, r.text, r.length);
|
||||
res->text[*len] = '\0';
|
||||
}
|
||||
|
||||
return FFEBAD;
|
||||
@ -501,7 +515,12 @@ ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
|
||||
#endif
|
||||
/* ffetarget_substr_character1 -- Perform SUBSTR op on three constants
|
||||
|
||||
Compare lengths, if equal then use memcmp. */
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
@ -519,8 +538,9 @@ ffetarget_substr_character1 (ffetargetCharacter1 *res,
|
||||
else
|
||||
{
|
||||
res->length = *len = last - first + 1;
|
||||
res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len);
|
||||
res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len + 1);
|
||||
memcpy (res->text, l.text + first - 1, *len);
|
||||
res->text[*len] = '\0';
|
||||
}
|
||||
|
||||
return FFEBAD;
|
||||
@ -666,6 +686,13 @@ ffetarget_convert_any_typeless_ (char *res, size_t size,
|
||||
return FFEBAD;
|
||||
}
|
||||
|
||||
/* Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
|
||||
@ -678,7 +705,7 @@ ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
|
||||
if (size <= l.length)
|
||||
memcpy (res->text, l.text, size);
|
||||
else
|
||||
@ -686,12 +713,21 @@ ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
|
||||
memcpy (res->text, l.text, l.length);
|
||||
memset (res->text + l.length, ' ', size - l.length);
|
||||
}
|
||||
res->text[size] = '\0';
|
||||
}
|
||||
|
||||
return FFEBAD;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
|
||||
@ -703,7 +739,8 @@ ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
|
||||
res->text[size] = '\0';
|
||||
if (size <= l.length)
|
||||
{
|
||||
char *p;
|
||||
@ -727,7 +764,14 @@ ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
|
||||
}
|
||||
|
||||
#endif
|
||||
/* ffetarget_convert_character1_integer1 -- Raw conversion. */
|
||||
/* ffetarget_convert_character1_integer4 -- Raw conversion.
|
||||
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
@ -788,7 +832,8 @@ ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
|
||||
res->text[size] = '\0';
|
||||
if (((size_t) size) <= size_of)
|
||||
{
|
||||
int i = size_of - size;
|
||||
@ -813,7 +858,14 @@ ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
|
||||
}
|
||||
|
||||
#endif
|
||||
/* ffetarget_convert_character1_logical1 -- Raw conversion. */
|
||||
/* ffetarget_convert_character1_logical4 -- Raw conversion.
|
||||
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
@ -874,7 +926,8 @@ ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
|
||||
res->text[size] = '\0';
|
||||
if (((size_t) size) <= size_of)
|
||||
{
|
||||
int i = size_of - size;
|
||||
@ -899,7 +952,14 @@ ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
|
||||
}
|
||||
|
||||
#endif
|
||||
/* ffetarget_convert_character1_typeless -- Raw conversion. */
|
||||
/* ffetarget_convert_character1_typeless -- Raw conversion.
|
||||
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
#if FFETARGET_okCHARACTER1
|
||||
ffebad
|
||||
@ -960,7 +1020,8 @@ ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
|
||||
res->text = NULL;
|
||||
else
|
||||
{
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
|
||||
res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
|
||||
res->text[size] = '\0';
|
||||
if (((size_t) size) <= size_of)
|
||||
{
|
||||
int i = size_of - size;
|
||||
@ -1101,17 +1162,21 @@ ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
|
||||
#endif
|
||||
/* ffetarget_hollerith -- Convert token to a hollerith constant
|
||||
|
||||
See prototype.
|
||||
|
||||
Token use count not affected overall. */
|
||||
Always append a null byte to the end, in case this is wanted in
|
||||
a special case such as passing a string as a FORMAT or %REF.
|
||||
Done to save a bit of hassle, nothing more, but it's a kludge anyway,
|
||||
because it isn't a "feature" that is self-documenting. Use the
|
||||
string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
|
||||
in the code. */
|
||||
|
||||
bool
|
||||
ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
|
||||
mallocPool pool)
|
||||
{
|
||||
val->length = ffelex_token_length (integer);
|
||||
val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length);
|
||||
val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length + 1);
|
||||
memcpy (val->text, ffelex_token_text (integer), val->length);
|
||||
val->text[val->length] = '\0';
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user