Commit 95638988 by Tobias Schlüter

trans-const.c (gfc_build_cstring_const): New function.

* trans-const.c (gfc_build_cstring_const): New function.
(gfc_init_cst): Use new function.
* trans-const.h (gfc_build_cstring_const): Add prototype.
* trans-io.c (set_string, set_error_locus): Use new function.
* trans-stmt.c (gfc_trans_goto): Use new function.

From-SVN: r88528
parent ee569894
...@@ -89,6 +89,14 @@ gfc_build_string_const (int length, const char *s) ...@@ -89,6 +89,14 @@ gfc_build_string_const (int length, const char *s)
return str; return str;
} }
/* Build a Fortran character constant from a zero-terminated string. */
tree
gfc_build_cstring_const (const char *s)
{
return gfc_build_string_const (strlen (s) + 1, s);
}
/* Return a string constant with the given length. Used for static /* Return a string constant with the given length. Used for static
initializers. The constant will be padded or truncated to match initializers. The constant will be padded or truncated to match
length. */ length. */
...@@ -147,17 +155,16 @@ gfc_init_constants (void) ...@@ -147,17 +155,16 @@ gfc_init_constants (void)
for (n = 0; n <= GFC_MAX_DIMENSIONS; n++) for (n = 0; n <= GFC_MAX_DIMENSIONS; n++)
gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n); gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n);
gfc_strconst_bounds = gfc_build_string_const (21, "Array bound mismatch"); gfc_strconst_bounds = gfc_build_cstring_const ("Array bound mismatch");
gfc_strconst_fault = gfc_strconst_fault =
gfc_build_string_const (30, "Array reference out of bounds"); gfc_build_cstring_const ("Array reference out of bounds");
gfc_strconst_wrong_return = gfc_strconst_wrong_return =
gfc_build_string_const (32, "Incorrect function return value"); gfc_build_cstring_const ("Incorrect function return value");
gfc_strconst_current_filename = gfc_strconst_current_filename =
gfc_build_string_const (strlen (gfc_option.source) + 1, gfc_build_cstring_const (gfc_option.source);
gfc_option.source);
} }
/* Converts a GMP integer into a backend tree node. */ /* Converts a GMP integer into a backend tree node. */
......
...@@ -35,6 +35,7 @@ tree gfc_conv_constant_to_tree (gfc_expr *); ...@@ -35,6 +35,7 @@ tree gfc_conv_constant_to_tree (gfc_expr *);
void gfc_conv_constant (gfc_se *, gfc_expr *); void gfc_conv_constant (gfc_se *, gfc_expr *);
tree gfc_build_string_const (int, const char *); tree gfc_build_string_const (int, const char *);
tree gfc_build_cstring_const (const char *);
/* Translate a string constant for a static initializer. */ /* Translate a string constant for a static initializer. */
tree gfc_conv_string_init (tree, gfc_expr *); tree gfc_conv_string_init (tree, gfc_expr *);
......
...@@ -409,7 +409,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ...@@ -409,7 +409,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
{ {
msg = msg =
gfc_build_string_const (37, "Assigned label is not a format label"); gfc_build_cstring_const ("Assigned label is not a format label");
tmp = GFC_DECL_STRING_LEN (se.expr); tmp = GFC_DECL_STRING_LEN (se.expr);
tmp = build2 (LE_EXPR, boolean_type_node, tmp = build2 (LE_EXPR, boolean_type_node,
tmp, convert (TREE_TYPE (tmp), integer_minus_one_node)); tmp, convert (TREE_TYPE (tmp), integer_minus_one_node));
...@@ -518,7 +518,7 @@ set_error_locus (stmtblock_t * block, locus * where) ...@@ -518,7 +518,7 @@ set_error_locus (stmtblock_t * block, locus * where)
int line; int line;
f = where->lb->file; f = where->lb->file;
tmp = gfc_build_string_const (strlen (f->filename) + 1, f->filename); tmp = gfc_build_cstring_const (f->filename);
tmp = gfc_build_addr_expr (pchar_type_node, tmp); tmp = gfc_build_addr_expr (pchar_type_node, tmp);
gfc_add_modify_expr (block, locus_file, tmp); gfc_add_modify_expr (block, locus_file, tmp);
......
...@@ -144,7 +144,7 @@ gfc_trans_goto (gfc_code * code) ...@@ -144,7 +144,7 @@ gfc_trans_goto (gfc_code * code)
gfc_start_block (&se.pre); gfc_start_block (&se.pre);
gfc_conv_expr (&se, code->expr); gfc_conv_expr (&se, code->expr);
assign_error = assign_error =
gfc_build_string_const (37, "Assigned label is not a target label"); gfc_build_cstring_const ("Assigned label is not a target label");
tmp = GFC_DECL_STRING_LEN (se.expr); tmp = GFC_DECL_STRING_LEN (se.expr);
tmp = build2 (NE_EXPR, boolean_type_node, tmp, integer_minus_one_node); tmp = build2 (NE_EXPR, boolean_type_node, tmp, integer_minus_one_node);
gfc_trans_runtime_check (tmp, assign_error, &se.pre); gfc_trans_runtime_check (tmp, assign_error, &se.pre);
...@@ -160,8 +160,7 @@ gfc_trans_goto (gfc_code * code) ...@@ -160,8 +160,7 @@ gfc_trans_goto (gfc_code * code)
} }
/* Check the label list. */ /* Check the label list. */
range_error = range_error = gfc_build_cstring_const ("Assigned label is not in the list");
gfc_build_string_const (34, "Assigned label is not in the list");
do do
{ {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment