rpms/gcc/devel gcc4-fortran-hollerith.patch, NONE, 1.1 gcc4-fortran-legacy.patch, NONE, 1.1 gcc4-fortran-logical-integer.patch, NONE, 1.1 gcc4-fortran-rh161634.patch, NONE, 1.1 gcc4-fortran-rh161669.patch, NONE, 1.1 gcc4-fortran-rh161679.patch, NONE, 1.1 gcc4-fortran-rh161680.patch, NONE, 1.1 gcc4-i386-masm=intel.patch, NONE, 1.1 gcc4-ia64-stack-protector.patch, NONE, 1.1 gcc4-libstdc++-pr22309.patch, NONE, 1.1 gcc4-s390-stack-protector.patch, NONE, 1.1 gcc4-stack-protector.patch, NONE, 1.1 .cvsignore, 1.97, 1.98 gcc4.spec, 1.51, 1.52 sources, 1.99, 1.100 gcc4-ada-target-bit.patch, 1.1, NONE gcc4-bitfield-ref-vec.patch, 1.1, NONE gcc4-c++-pr19317.patch, 1.2, NONE gcc4-hard-regno-nregs.patch, 1.1, NONE gcc4-libstdc++-v3-versioning.patch, 1.4, NONE gcc4-pr19005-test.patch, 1.1, NONE gcc4-pr20249.patch, 1.5, NONE gcc4-pr20490.patch, 1.3, NONE gcc4-pr21897.patch, 1.1, NONE gcc4-rh133180.patch, 1.1, NONE gcc4-slow-pthread-self.patch, 1.1, NONE
fedora-cvs-commits at redhat.com
fedora-cvs-commits at redhat.com
Fri Jul 8 21:09:26 UTC 2005
Author: jakub
Update of /cvs/dist/rpms/gcc/devel
In directory cvs.devel.redhat.com:/tmp/cvs-serv22386
Modified Files:
.cvsignore gcc4.spec sources
Added Files:
gcc4-fortran-hollerith.patch gcc4-fortran-legacy.patch
gcc4-fortran-logical-integer.patch gcc4-fortran-rh161634.patch
gcc4-fortran-rh161669.patch gcc4-fortran-rh161679.patch
gcc4-fortran-rh161680.patch gcc4-i386-masm=intel.patch
gcc4-ia64-stack-protector.patch gcc4-libstdc++-pr22309.patch
gcc4-s390-stack-protector.patch gcc4-stack-protector.patch
Removed Files:
gcc4-ada-target-bit.patch gcc4-bitfield-ref-vec.patch
gcc4-c++-pr19317.patch gcc4-hard-regno-nregs.patch
gcc4-libstdc++-v3-versioning.patch gcc4-pr19005-test.patch
gcc4-pr20249.patch gcc4-pr20490.patch gcc4-pr21897.patch
gcc4-rh133180.patch gcc4-slow-pthread-self.patch
Log Message:
4.0.1-1
gcc4-fortran-hollerith.patch:
gcc/fortran/arith.c | 174 +++++++++++++++++++++++--
gcc/fortran/arith.h | 5
gcc/fortran/expr.c | 22 +++
gcc/fortran/gfortran.h | 5
gcc/fortran/gfortran.texi | 30 ++++
gcc/fortran/intrinsic.c | 39 +++++
gcc/fortran/io.c | 74 +++++++---
gcc/fortran/misc.c | 6
gcc/fortran/primary.c | 73 ++++++++++
gcc/fortran/simplify.c | 28 ++++
gcc/fortran/trans-const.c | 44 +++++-
gcc/fortran/trans-io.c | 73 ++++++++++
gcc/testsuite/gfortran.dg/g77/cpp4.F | 12 +
gcc/testsuite/gfortran.dg/hollerith.f90 | 108 +++++++++++++++
gcc/testsuite/gfortran.dg/hollerith2.f90 | 26 +++
gcc/testsuite/gfortran.dg/hollerith3.f90 | 9 +
gcc/testsuite/gfortran.dg/hollerith4.f90 | 29 ++++
gcc/testsuite/gfortran.dg/hollerith_f95.f90 | 100 ++++++++++++++
gcc/testsuite/gfortran.dg/hollerith_legacy.f90 | 61 ++++++++
libgfortran/io/transfer.c | 2
20 files changed, 876 insertions(+), 44 deletions(-)
--- NEW FILE gcc4-fortran-hollerith.patch ---
2005-07-07 Steven Bosscher <stevenb at suse.de>
* primary.c (match_hollerith_constant): Use int, not unsigned int,
for the hollerith length. Fix indentation.
2005-07-07 Feng Wang <fengwang at nudt.edu.cn>
PR fortran/16531
PR fortran/15966
PR fortran/18781
* arith.c (gfc_hollerith2int, gfc_hollerith2real,
gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
New functions.
(eval_intrinsic): Don't evaluate if Hollerith constant arguments exist.
* arith.h (gfc_hollerith2int, gfc_hollerith2real,
gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
Add prototypes.
* expr.c (free_expr0): Free memery allocated for Hollerith constant.
(gfc_copy_expr): Allocate and copy string if Expr is from Hollerith.
(gfc_check_assign): Enable conversion from Hollerith to other.
* gfortran.h (bt): Add BT_HOLLERITH.
(gfc_expr): Add from_H flag.
* intrinsic.c (gfc_type_letter): Return 'h' for BT_HOLLERITH.
(add_conversions): Add conversions from Hollerith constant to other.
(do_simplify): Don't simplify if Hollerith constant arguments exist.
* io.c (resolve_tag): Enable array in FORMAT tag under GFC_STD_GNU.
* misc.c (gfc_basetype_name): Return "HOLLERITH" for BT_HOLLERITH.
(gfc_type_name): Print "HOLLERITH" for BT_HOLLERITH.
* primary.c (match_hollerith_constant): New function.
(gfc_match_literal_constant): Add match Hollerith before Integer.
* simplify.c (gfc_convert_constant): Add conversion from Hollerith
to other.
* trans-const.c (gfc_conv_constant_to_tree): Use VIEW_CONVERT_EXPR to
convert Hollerith constant to tree.
* trans-io.c (gfc_convert_array_to_string): Get array's address and
length to set string expr.
(set_string): Deal with array assigned Hollerith constant and character
array.
* gfortran.texi: Document Hollerith constants as extention support.
PR fortran/16531
PR fortran/15966
PR fortran/18781
* gfortran.dg/hollerith.f90: New.
* gfortran.dg/hollerith2.f90: New.
* gfortran.dg/hollerith3.f90: New.
* gfortran.dg/hollerith4.f90: New.
* gfortran.dg/hollerith_f95.f90: New.
* gfortran.dg/hollerith_legacy.f90: New.
* gfortran.dg/g77/cpp4.F: New. Port from g77.
PR fortran/16531
* io/transfer.c (formatted_transfer): Enable FMT_A on other types to
support Hollerith constants.
--- gcc/fortran/arith.c 25 Jun 2005 00:40:33 -0000 1.29
+++ gcc/fortran/arith.c 7 Jul 2005 07:54:41 -0000 1.30
@@ -1582,17 +1582,19 @@ eval_intrinsic (gfc_intrinsic_op operato
if (operator == INTRINSIC_POWER && op2->ts.type != BT_INTEGER)
goto runtime;
- if (op1->expr_type != EXPR_CONSTANT
- && (op1->expr_type != EXPR_ARRAY
- || !gfc_is_constant_expr (op1)
- || !gfc_expanded_ac (op1)))
+ if (op1->from_H
+ || (op1->expr_type != EXPR_CONSTANT
+ && (op1->expr_type != EXPR_ARRAY
+ || !gfc_is_constant_expr (op1)
+ || !gfc_expanded_ac (op1))))
goto runtime;
if (op2 != NULL
- && op2->expr_type != EXPR_CONSTANT
- && (op2->expr_type != EXPR_ARRAY
- || !gfc_is_constant_expr (op2)
- || !gfc_expanded_ac (op2)))
+ && (op2->from_H
+ || (op2->expr_type != EXPR_CONSTANT
+ && (op2->expr_type != EXPR_ARRAY
+ || !gfc_is_constant_expr (op2)
+ || !gfc_expanded_ac (op2)))))
goto runtime;
if (unary)
@@ -2214,3 +2216,159 @@ gfc_int2log (gfc_expr *src, int kind)
return result;
}
+/* Convert Hollerith to integer. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_hollerith2int (gfc_expr * src, int kind)
+{
+ gfc_expr *result;
+ int len;
+
+ len = src->value.character.length;
+
+ result = gfc_get_expr ();
+ result->expr_type = EXPR_CONSTANT;
+ result->ts.type = BT_INTEGER;
+ result->ts.kind = kind;
+ result->where = src->where;
+ result->from_H = 1;
+
+ if (len > kind)
+ {
+ gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+ &src->where, gfc_typename(&result->ts));
+ }
+ result->value.character.string = gfc_getmem (kind + 1);
+ memcpy (result->value.character.string, src->value.character.string,
+ MIN (kind, len));
+
+ if (len < kind)
+ memset (&result->value.character.string[len], ' ', kind - len);
+
+ result->value.character.string[kind] = '\0'; /* For debugger */
+ result->value.character.length = kind;
+
+ return result;
+}
+
+/* Convert Hollerith to real. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_hollerith2real (gfc_expr * src, int kind)
+{
+ gfc_expr *result;
+ int len;
+
+ len = src->value.character.length;
+
+ result = gfc_get_expr ();
+ result->expr_type = EXPR_CONSTANT;
+ result->ts.type = BT_REAL;
+ result->ts.kind = kind;
+ result->where = src->where;
+ result->from_H = 1;
+
+ if (len > kind)
+ {
+ gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+ &src->where, gfc_typename(&result->ts));
+ }
+ result->value.character.string = gfc_getmem (kind + 1);
+ memcpy (result->value.character.string, src->value.character.string,
+ MIN (kind, len));
+
+ if (len < kind)
+ memset (&result->value.character.string[len], ' ', kind - len);
+
+ result->value.character.string[kind] = '\0'; /* For debugger */
+ result->value.character.length = kind;
+
+ return result;
+}
+
+/* Convert Hollerith to complex. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_hollerith2complex (gfc_expr * src, int kind)
+{
+ gfc_expr *result;
+ int len;
+
+ len = src->value.character.length;
+
+ result = gfc_get_expr ();
+ result->expr_type = EXPR_CONSTANT;
+ result->ts.type = BT_COMPLEX;
+ result->ts.kind = kind;
+ result->where = src->where;
+ result->from_H = 1;
+
+ kind = kind * 2;
+
+ if (len > kind)
+ {
+ gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+ &src->where, gfc_typename(&result->ts));
+ }
+ result->value.character.string = gfc_getmem (kind + 1);
+ memcpy (result->value.character.string, src->value.character.string,
+ MIN (kind, len));
+
+ if (len < kind)
+ memset (&result->value.character.string[len], ' ', kind - len);
+
+ result->value.character.string[kind] = '\0'; /* For debugger */
+ result->value.character.length = kind;
+
+ return result;
+}
+
+/* Convert Hollerith to character. */
+
+gfc_expr *
+gfc_hollerith2character (gfc_expr * src, int kind)
+{
+ gfc_expr *result;
+
+ result = gfc_copy_expr (src);
+ result->ts.type = BT_CHARACTER;
+ result->ts.kind = kind;
+ result->from_H = 1;
+
+ return result;
+}
+
+/* Convert Hollerith to logical. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_hollerith2logical (gfc_expr * src, int kind)
+{
+ gfc_expr *result;
+ int len;
+
+ len = src->value.character.length;
+
+ result = gfc_get_expr ();
+ result->expr_type = EXPR_CONSTANT;
+ result->ts.type = BT_LOGICAL;
+ result->ts.kind = kind;
+ result->where = src->where;
+ result->from_H = 1;
+
+ if (len > kind)
+ {
+ gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+ &src->where, gfc_typename(&result->ts));
+ }
+ result->value.character.string = gfc_getmem (kind + 1);
+ memcpy (result->value.character.string, src->value.character.string,
+ MIN (kind, len));
+
+ if (len < kind)
+ memset (&result->value.character.string[len], ' ', kind - len);
+
+ result->value.character.string[kind] = '\0'; /* For debugger */
+ result->value.character.length = kind;
+
+ return result;
+}
--- gcc/fortran/expr.c 25 Jun 2005 00:40:34 -0000 1.26
+++ gcc/fortran/expr.c 7 Jul 2005 07:54:41 -0000 1.27
@@ -141,6 +141,12 @@ free_expr0 (gfc_expr * e)
switch (e->expr_type)
{
case EXPR_CONSTANT:
+ if (e->from_H)
+ {
+ gfc_free (e->value.character.string);
+ break;
+ }
+
switch (e->ts.type)
{
case BT_INTEGER:
@@ -152,6 +158,7 @@ free_expr0 (gfc_expr * e)
break;
case BT_CHARACTER:
+ case BT_HOLLERITH:
gfc_free (e->value.character.string);
break;
@@ -393,6 +400,15 @@ gfc_copy_expr (gfc_expr * p)
break;
case EXPR_CONSTANT:
+ if (p->from_H)
+ {
+ s = gfc_getmem (p->value.character.length + 1);
+ q->value.character.string = s;
+
+ memcpy (s, p->value.character.string,
+ p->value.character.length + 1);
+ break;
+ }
switch (q->ts.type)
{
case BT_INTEGER:
@@ -414,6 +430,7 @@ gfc_copy_expr (gfc_expr * p)
break;
case BT_CHARACTER:
+ case BT_HOLLERITH:
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
@@ -1813,7 +1830,10 @@ gfc_check_assign (gfc_expr * lvalue, gfc
if (!conform)
{
- if (gfc_numeric_ts (&lvalue->ts) && gfc_numeric_ts (&rvalue->ts))
+ /* Numeric can be converted to any other numeric. And Hollerith can be
+ converted to any other type. */
+ if ((gfc_numeric_ts (&lvalue->ts) && gfc_numeric_ts (&rvalue->ts))
+ || rvalue->ts.type == BT_HOLLERITH)
return SUCCESS;
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
--- gcc/fortran/intrinsic.c 25 Jun 2005 00:40:34 -0000 1.51
+++ gcc/fortran/intrinsic.c 7 Jul 2005 07:54:42 -0000 1.52
@@ -79,6 +79,10 @@ gfc_type_letter (bt type)
c = 'c';
break;
+ case BT_HOLLERITH:
+ c = 'h';
+ break;
+
default:
c = 'u';
break;
@@ -2327,6 +2331,31 @@ add_conversions (void)
BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
}
+ if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+ {
+ /* Hollerith-Integer conversions. */
+ for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ /* Hollerith-Real conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Hollerith-Complex conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+
+ /* Hollerith-Character conversions. */
+ add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
+ gfc_default_character_kind, GFC_STD_LEGACY);
+
+ /* Hollerith-Logical conversions. */
+ for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+ }
+
/* Real/Complex - Real/Complex conversions. */
for (i = 0; gfc_real_kinds[i].kind != 0; i++)
for (j = 0; gfc_real_kinds[j].kind != 0; j++)
@@ -2713,6 +2742,16 @@ do_simplify (gfc_intrinsic_sym * specifi
gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
gfc_actual_arglist *arg;
+ /* Check the arguments if there are Hollerith constants. We deal with
+ them at run-time. */
+ for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
+ {
+ if (arg->expr && arg->expr->from_H)
+ {
+ result = NULL;
+ goto finish;
+ }
+ }
/* Max and min require special handling due to the variable number
of args. */
if (specific->simplify.f1 == gfc_simplify_min)
--- gcc/fortran/io.c 3 Jul 2005 01:46:06 -0000 1.27
+++ gcc/fortran/io.c 7 Jul 2005 07:54:42 -0000 1.28
@@ -969,33 +969,63 @@ resolve_tag (const io_tag * tag, gfc_exp
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
- if (e->ts.type != tag->type)
+ if (e->ts.type != tag->type && tag != &tag_format)
{
- /* Format label can be integer varibale. */
- if (tag != &tag_format || e->ts.type != BT_INTEGER)
- {
- gfc_error ("%s tag at %L must be of type %s or %s", tag->name,
- &e->where, gfc_basic_typename (tag->type),
- gfc_basic_typename (BT_INTEGER));
- return FAILURE;
- }
+ gfc_error ("%s tag at %L must be of type %s", tag->name,
+ &e->where, gfc_basic_typename (tag->type));
+ return FAILURE;
}
if (tag == &tag_format)
{
- if (e->rank != 1 && e->rank != 0)
- {
- gfc_error ("FORMAT tag at %L cannot be array of strings",
- &e->where);
- return FAILURE;
- }
- /* Check assigned label. */
- if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_INTEGER
- && e->symtree->n.sym->attr.assign != 1)
- {
- gfc_error ("Variable '%s' has not been assigned a format label at %L",
- e->symtree->n.sym->name, &e->where);
- return FAILURE;
+ /* If e's rank is zero and e is not an element of an array, it should be
+ of integer or character type. The integer variable should be
+ ASSIGNED. */
+ if (e->symtree == NULL || e->symtree->n.sym->as == NULL
+ || e->symtree->n.sym->as->rank == 0)
+ {
+ if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
+ {
+ gfc_error ("%s tag at %L must be of type %s or %s", tag->name,
+ &e->where, gfc_basic_typename (BT_CHARACTER),
+ gfc_basic_typename (BT_INTEGER));
+ return FAILURE;
+ }
+ else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
+ {
+ if (gfc_notify_std (GFC_STD_F95_DEL,
+ "Obsolete: ASSIGNED variable in FORMAT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ if (e->symtree->n.sym->attr.assign != 1)
+ {
+ gfc_error ("Variable '%s' at %L has not been assigned a "
+ "format label", e->symtree->n.sym->name, &e->where);
+ return FAILURE;
+ }
+ }
+ return SUCCESS;
+ }
+ else
+ {
+ /* if rank is nonzero, we allow the type to be character under
+ GFC_STD_GNU and other type under GFC_STD_LEGACY. It may be
+ assigned an Hollerith constant. */
+ if (e->ts.type == BT_CHARACTER)
+ {
+ if (gfc_notify_std (GFC_STD_GNU,
+ "Extension: Character array in FORMAT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
+ else
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY,
+ "Extension: Non-character in FORMAT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
+ return SUCCESS;
}
}
else
--- gcc/fortran/misc.c 25 Jun 2005 00:40:35 -0000 1.9
+++ gcc/fortran/misc.c 7 Jul 2005 07:54:42 -0000 1.10
@@ -159,6 +159,9 @@ gfc_basic_typename (bt type)
case BT_CHARACTER:
p = "CHARACTER";
break;
+ case BT_HOLLERITH:
+ p = "HOLLERITH";
+ break;
case BT_DERIVED:
p = "DERIVED";
break;
@@ -207,6 +210,9 @@ gfc_typename (gfc_typespec * ts)
case BT_CHARACTER:
sprintf (buffer, "CHARACTER(%d)", ts->kind);
break;
+ case BT_HOLLERITH:
+ sprintf (buffer, "HOLLERITH");
+ break;
case BT_DERIVED:
sprintf (buffer, "TYPE(%s)", ts->derived->name);
break;
--- gcc/fortran/primary.c 25 Jun 2005 00:40:35 -0000 1.28
+++ gcc/fortran/primary.c 7 Jul 2005 11:59:29 -0000 1.30
@@ -228,6 +228,75 @@ match_integer_constant (gfc_expr ** resu
}
+/* Match a Hollerith constant. */
+
+static match
+match_hollerith_constant (gfc_expr ** result)
+{
+ locus old_loc;
+ gfc_expr * e = NULL;
+ const char * msg;
+ char * buffer;
+ int num;
+ int i;
+
+ old_loc = gfc_current_locus;
+ gfc_gobble_whitespace ();
+
+ if (match_integer_constant (&e, 0) == MATCH_YES
+ && gfc_match_char ('h') == MATCH_YES)
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY,
+ "Extention: Hollerith constant at %C")
+ == FAILURE)
+ goto cleanup;
+
+ msg = gfc_extract_int (e, &num);
+ if (msg != NULL)
+ {
+ gfc_error (msg);
+ goto cleanup;
+ }
+ if (num == 0)
+ {
+ gfc_error ("Invalid Hollerith constant: %L must contain at least one "
+ "character", &old_loc);
+ goto cleanup;
+ }
+ if (e->ts.kind != gfc_default_integer_kind)
+ {
+ gfc_error ("Invalid Hollerith constant: Interger kind at %L "
+ "should be default", &old_loc);
+ goto cleanup;
+ }
+ else
+ {
+ buffer = (char *) gfc_getmem (sizeof(char) * num + 1);
+ for (i = 0; i < num; i++)
+ {
+ buffer[i] = gfc_next_char_literal (1);
+ }
+ gfc_free_expr (e);
+ e = gfc_constant_result (BT_HOLLERITH,
+ gfc_default_character_kind, &gfc_current_locus);
+ e->value.character.string = gfc_getmem (num+1);
+ memcpy (e->value.character.string, buffer, num);
+ e->value.character.length = num;
+ *result = e;
+ return MATCH_YES;
+ }
+ }
+
+ gfc_free_expr (e);
+ gfc_current_locus = old_loc;
+ return MATCH_NO;
+
+cleanup:
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+}
+
+
/* Match a binary, octal or hexadecimal constant that can be found in
a DATA statement. */
@@ -1159,6 +1228,10 @@ gfc_match_literal_constant (gfc_expr **
if (m != MATCH_NO)
return m;
+ m = match_hollerith_constant (result);
+ if (m != MATCH_NO)
+ return m;
+
m = match_integer_constant (result, signflag);
if (m != MATCH_NO)
return m;
--- gcc/fortran/simplify.c 25 Jun 2005 00:40:35 -0000 1.29
+++ gcc/fortran/simplify.c 7 Jul 2005 07:54:42 -0000 1.30
@@ -3774,6 +3774,34 @@ gfc_convert_constant (gfc_expr * e, bt t
}
break;
+ case BT_HOLLERITH:
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_hollerith2int;
+ break;
+
+ case BT_REAL:
+ f = gfc_hollerith2real;
+ break;
+
+ case BT_COMPLEX:
+ f = gfc_hollerith2complex;
+ break;
+
+ case BT_CHARACTER:
+ f = gfc_hollerith2character;
+ break;
+
+ case BT_LOGICAL:
+ f = gfc_hollerith2logical;
+ break;
+
+ default:
+ goto oops;
+ }
+ break;
+
default:
oops:
gfc_internal_error ("gfc_convert_constant(): Unexpected type");
--- gcc/fortran/trans-const.c 25 Jun 2005 00:40:36 -0000 1.28
+++ gcc/fortran/trans-const.c 7 Jul 2005 07:54:43 -0000 1.29
@@ -299,29 +299,57 @@ gfc_conv_constant_to_tree (gfc_expr * ex
{
gcc_assert (expr->expr_type == EXPR_CONSTANT);
+ /* If it is converted from Hollerith constant, we build string constant
+ and VIEW_CONVERT to its type. */
+
switch (expr->ts.type)
{
case BT_INTEGER:
- return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
+ if (expr->from_H)
+ return build1 (VIEW_CONVERT_EXPR,
+ gfc_get_int_type (expr->ts.kind),
+ gfc_build_string_const (expr->value.character.length,
+ expr->value.character.string));
+ else
+ return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
case BT_REAL:
- return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind);
+ if (expr->from_H)
+ return build1 (VIEW_CONVERT_EXPR,
+ gfc_get_real_type (expr->ts.kind),
+ gfc_build_string_const (expr->value.character.length,
+ expr->value.character.string));
+ else
+ return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind);
case BT_LOGICAL:
- return build_int_cst (gfc_get_logical_type (expr->ts.kind),
+ if (expr->from_H)
+ return build1 (VIEW_CONVERT_EXPR,
+ gfc_get_logical_type (expr->ts.kind),
+ gfc_build_string_const (expr->value.character.length,
+ expr->value.character.string));
+ else
+ return build_int_cst (gfc_get_logical_type (expr->ts.kind),
expr->value.logical);
case BT_COMPLEX:
- {
- tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r,
+ if (expr->from_H)
+ return build1 (VIEW_CONVERT_EXPR,
+ gfc_get_complex_type (expr->ts.kind),
+ gfc_build_string_const (expr->value.character.length,
+ expr->value.character.string));
+ else
+ {
+ tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r,
expr->ts.kind);
- tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i,
+ tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i,
expr->ts.kind);
- return build_complex (NULL_TREE, real, imag);
- }
+ return build_complex (NULL_TREE, real, imag);
+ }
case BT_CHARACTER:
+ case BT_HOLLERITH:
return gfc_build_string_const (expr->value.character.length,
expr->value.character.string);
--- gcc/fortran/trans-io.c 25 Jun 2005 00:40:36 -0000 1.37
+++ gcc/fortran/trans-io.c 7 Jul 2005 07:54:43 -0000 1.38
@@ -364,6 +364,68 @@ set_parameter_ref (stmtblock_t * block,
gfc_add_modify_expr (block, tmp, se.expr);
}
+/* Given an array expr, find its address and length to get a string. If the
+ array is full, the string's address is the address of array's first element
+ and the length is the size of the whole array. If it is an element, the
+ string's address is the element's address and the length is the rest size of
+ the array.
+*/
+
+static void
+gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
+{
+ tree tmp;
+ tree array;
+ tree type;
+ tree size;
+ int rank;
+ gfc_symbol *sym;
+
+ sym = e->symtree->n.sym;
+ rank = sym->as->rank - 1;
+
+ if (e->ref->u.ar.type == AR_FULL)
+ {
+ se->expr = gfc_get_symbol_decl (sym);
+ se->expr = gfc_conv_array_data (se->expr);
+ }
+ else
+ {
+ gfc_conv_expr (se, e);
+ }
+
+ array = sym->backend_decl;
+ type = TREE_TYPE (array);
+
+ if (GFC_ARRAY_TYPE_P (type))
+ size = GFC_TYPE_ARRAY_SIZE (type);
+ else
+ {
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ size = gfc_conv_array_stride (array, rank);
+ tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_array_ubound (array, rank),
+ gfc_conv_array_lbound (array, rank)));
+ tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, tmp,
+ gfc_index_one_node));
+ size = fold (build2 (MULT_EXPR, gfc_array_index_type, tmp, size));
+ }
+
+ gcc_assert (size);
+
+ /* If it is an element, we need the its address and size of the rest. */
+ if (e->ref->u.ar.type == AR_ELEMENT)
+ {
+ size = fold (build2 (MINUS_EXPR, gfc_array_index_type, size,
+ TREE_OPERAND (se->expr, 1)));
+ se->expr = gfc_build_addr_expr (NULL, se->expr);
+ }
+
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+ size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp));
+
+ se->string_length = fold_convert (gfc_charlen_type_node, size);
+}
/* Generate code to store a string and its length into the
ioparm structure. */
@@ -400,7 +462,15 @@ set_string (stmtblock_t * block, stmtblo
}
else
{
- gfc_conv_expr (&se, e);
+ /* General character. */
+ if (e->ts.type == BT_CHARACTER && e->rank == 0)
+ gfc_conv_expr (&se, e);
+ /* Array assigned Hollerith constant or character array. */
+ else if (e->symtree && (e->symtree->n.sym->as->rank > 0))
+ gfc_convert_array_to_string (&se, e);
+ else
+ gcc_unreachable ();
+
gfc_conv_string_parameter (&se);
gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
gfc_add_modify_expr (&se.pre, len, se.string_length);
@@ -408,7 +478,6 @@ set_string (stmtblock_t * block, stmtblo
gfc_add_block_to_block (block, &se.pre);
gfc_add_block_to_block (postblock, &se.post);
-
}
--- gcc/fortran/arith.h 25 Jun 2005 00:40:33 -0000 1.6
+++ gcc/fortran/arith.h 7 Jul 2005 07:54:43 -0000 1.7
@@ -82,6 +82,11 @@ gfc_expr *gfc_complex2complex (gfc_expr
gfc_expr *gfc_log2log (gfc_expr *, int);
gfc_expr *gfc_log2int (gfc_expr *, int);
gfc_expr *gfc_int2log (gfc_expr *, int);
+gfc_expr *gfc_hollerith2int (gfc_expr *, int);
+gfc_expr *gfc_hollerith2real (gfc_expr *, int);
+gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
+gfc_expr *gfc_hollerith2character (gfc_expr *, int);
+gfc_expr *gfc_hollerith2logical (gfc_expr *, int);
#endif /* GFC_ARITH_H */
--- gcc/fortran/gfortran.h 3 Jul 2005 14:27:47 -0000 1.74
+++ gcc/fortran/gfortran.h 7 Jul 2005 07:54:43 -0000 1.75
@@ -127,7 +127,7 @@ gfc_source_form;
typedef enum
{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX,
- BT_LOGICAL, BT_CHARACTER, BT_DERIVED, BT_PROCEDURE
+ BT_LOGICAL, BT_CHARACTER, BT_DERIVED, BT_PROCEDURE, BT_HOLLERITH
}
bt;
@@ -1077,6 +1077,9 @@ typedef struct gfc_expr
locus where;
+ /* True if it is converted from Hollerith constant. */
+ unsigned int from_H : 1;
+
union
{
int logical;
--- libgfortran/io/transfer.c 1 Jul 2005 05:44:50 -0000 1.46
+++ libgfortran/io/transfer.c 7 Jul 2005 07:54:57 -0000 1.47
@@ -524,8 +524,6 @@ formatted_transfer (bt type, void *p, in
case FMT_A:
if (n == 0)
goto need_data;
- if (require_type (BT_CHARACTER, type, f))
- return;
if (g.mode == READING)
read_a (f, p, len);
--- gcc/testsuite/gfortran.dg/hollerith.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,108 @@
+! { dg-do run }
+! PR15966, PR18781 & PR16531
+implicit none
+complex*16 x(2)
+complex*8 a(2,2)
+character*4 z
+character z1(4)
+character*4 z2(2,2)
+character*80 line
+integer*4 i
+logical*4 l
+real*4 r
+character*8 c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+l = 4Ho wo
+r = 4Hrld!
+write (line, '(3A4)') i, l, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+r = 2Hab
+l = 2Hab
+c = 2Hab
+write (line, '(3A4, 8A)') i, l, r, c
+if (line .ne. 'ab ab ab ab ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. ' 3') call abort
+write (line, a (1,2)) 4
+if (line .ne. ' 4') call abort
+write (line, z) 5
+if (line .ne. ' 5') call abort
+write (line, z1) 6
+if (line .ne. ' 6') call abort
+write (line, z2) 7
+if (line .ne. ' 7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. ' 8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h hello)
+end
+
+subroutine test (h)
+integer*8 h
+character*80 line
+
+write (line, '(8a)') h
+if (line .ne. ' hello') call abort
+end subroutine
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 15 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 15 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 16 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 16 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 17 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 18 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 19 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 21 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 21 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 22 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 22 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 23 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 23 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 24 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 24 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 27 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 27 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 28 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 28 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 29 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 29 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 30 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 30 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 37 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 39 }
+
+! { dg-warning "Character array in FORMAT tag" "" { target *-*-* } 43 }
+
+! { dg-warning "Character array in FORMAT tag" "" { target *-*-* } 45 }
+
+! { dg-warning "Character array in FORMAT tag" "" { target *-*-* } 47 }
+
+! { dg-warning "Hollerith constant" "" { target *-*-* } 51 }
--- gcc/testsuite/gfortran.dg/hollerith2.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith2.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,26 @@
+ ! { dg-do run }
+ ! Program to test Hollerith constant.
+ Program test
+ implicit none
+ integer* 4 i,j
+ real r, x, y
+ parameter (i = 4h1234)
+ parameter (r = 4hdead)
+ parameter (y = 4*r)
+ parameter (j = selected_real_kind (i))
+ x = 4H1234
+ x = sin(r)
+ x = x * r
+ x = x / r
+ x = x + r
+ x = x - r
+ end
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 7 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 7 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 8 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 8 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 11 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 11 }
+
--- gcc/testsuite/gfortran.dg/hollerith3.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith3.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,9 @@
+ ! { dg-do compile }
+ ! { dg-options "-w" }
+ ! Program to test invalid Hollerith constant.
+ Program test
+ implicit none
+ integer i
+ i = 0H ! { dg-error "at least one character" }
+ i = 4_8H1234 ! { dg-error "should be default" }
+ end
--- gcc/testsuite/gfortran.dg/hollerith4.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith4.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Test Hollerith constant assigned to allocatable array
+
+integer, allocatable :: c (:,:)
+character (len = 20) ch
+allocate (c(1,2))
+
+c(1,1) = 4H(A4)
+c(1,2) = 4H(A5)
+
+write (ch, "(2A4)") c
+if (ch .ne. "(A4)(A5)") call abort()
+write (ch, c) 'Hello'
+if (ch .ne. "Hell") call abort()
+write (ch, c (1,2)) 'Hello'
+if (ch .ne. "Hello") call abort()
+end
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 8 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 8 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 9 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 9 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 13 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 15 }
+
+
--- gcc/testsuite/gfortran.dg/hollerith_f95.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith_f95.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,100 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR15966, PR18781 & PR16531
+implicit none
+complex*16 x(2)
+complex*8 a(2,2)
+character*4 z
+character z1(4)
+character*4 z2(2,2)
+character*80 line
+integer*4 i
+logical*4 l
+real*4 r
+character*8 c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+l = 4Ho wo
+r = 4Hrld!
+write (line, '(3A4)') i, l, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+r = 2Hab
+l = 2Hab
+c = 2Hab
+write (line, '(3A4, 8A)') i, l, r, c
+if (line .ne. 'ab ab ab ab ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. ' 3') call abort
+write (line, a (1,2)) 4
+if (line .ne. ' 4') call abort
+write (line, z) 5
+if (line .ne. ' 5') call abort
+write (line, z1) 6
+if (line .ne. ' 6') call abort
+write (line, z2) 7
+if (line .ne. ' 7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. ' 8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h hello)
+end
+
+subroutine test (h)
+integer*8 h
+character*80 line
+
+write (line, '(8a)') h
+if (line .ne. ' hello') call abort
+end subroutine
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 16 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 17 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 18 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 19 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 20 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 22 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 23 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 24 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 25 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 28 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 29 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 30 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 31 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 52 }
+
+! { dg-error "Non-character in FORMAT tag" "" { target *-*-* } 38 }
+
+! { dg-error "Non-character in FORMAT tag" "" { target *-*-* } 40 }
+
+! { dg-error "Character array in FORMAT tag" "" { target *-*-* } 44 }
+
+! { dg-error "Character array in FORMAT tag" "" { target *-*-* } 46 }
+
+! { dg-error "Character array in FORMAT tag" "" { target *-*-* } 48 }
+
--- gcc/testsuite/gfortran.dg/hollerith_legacy.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/hollerith_legacy.f90 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! PR15966, PR18781 & PR16531
+implicit none
+complex*16 x(2)
+complex*8 a(2,2)
+character*4 z
+character z1(4)
+character*4 z2(2,2)
+character*80 line
+integer*4 i
+logical*4 l
+real*4 r
+character*8 c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+l = 4Ho wo
+r = 4Hrld!
+write (line, '(3A4)') i, l, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+r = 2Hab
+l = 2Hab
+c = 2Hab
+write (line, '(3A4, 8A)') i, l, r, c
+if (line .ne. 'ab ab ab ab ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. ' 3') call abort
+write (line, a (1,2)) 4
+if (line .ne. ' 4') call abort
+write (line, z) 5
+if (line .ne. ' 5') call abort
+write (line, z1) 6
+if (line .ne. ' 6') call abort
+write (line, z2) 7
+if (line .ne. ' 7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. ' 8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h hello)
+end
+
+subroutine test (h)
+integer*8 h
+character*80 line
+
+write (line, '(8a)') h
+if (line .ne. ' hello') call abort
+end subroutine
--- gcc/testsuite/gfortran.dg/g77/cpp4.F 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/g77/cpp4.F 7 Jul 2005 07:54:58 -0000 1.1
@@ -0,0 +1,12 @@
+ ! { dg-do run }
+C The preprocessor must not mangle Hollerith constants
+C which contain apostrophes.
+ integer i
+ character*4 j
+ data i /4hbla'/
+ write (j, '(4a)') i
+ if (j .ne. "bla'") call abort
+ end
+
+ ! { dg-warning "Hollerith constant" "const" { target *-*-* } 6 }
+ ! { dg-warning "Conversion" "conversion" { target *-*-* } 6 }
--- gcc/fortran/gfortran.texi 3 Jul 2005 18:39:20 -0000 1.19
+++ gcc/fortran/gfortran.texi 7 Jul 2005 07:56:46 -0000 1.20
@@ -632,6 +632,7 @@ of extensions, and @option{-std=legacy}
* Real array indices::
* Unary operators::
* Implicitly interconvert LOGICAL and INTEGER::
+* Hollerith constants support::
@end menu
@node Old-style kind specifications
@@ -804,6 +805,35 @@ converting from INTEGER to LOGICAL, the
i = .FALSE.
@end smallexample
+ at node Hollerith constants support
+ at section Hollerith constants support
+ at cindex Hollerith constants
+
+A Hollerith constant is a string of characters preceded by the letter @samp{H}
+or @samp{h}, and there must be an literal, unsigned, nonzero default integer
+constant indicating the number of characters in the string. Hollerith constants
+are stored as byte strings, one character per byte.
+
+ at command{gfortran} supports Hollerith constants. They can be used as the right
+hands in the @code{DATA} statement and @code{ASSIGN} statement, also as the
+arguments. The left hands can be of Integer, Real, Complex and Logical type.
+The constant will be padded or trancated to fit the size of left hand.
+
+Valid Hollerith constants examples:
+ at smallexample
+complex*16 x(2)
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+call foo (4H abc)
+x(1) = 16Habcdefghijklmnop
+ at end smallexample
+
+Invalid Hollerith constants examples:
+ at smallexample
+integer*4 a
+a = 8H12345678 ! The Hollerith constant is too long. It will be truncated.
+a = 0H ! At least one character needed.
+ at end smallexample
+
@include intrinsic.texi
@c ---------------------------------------------------------------------
@c Contributing
gcc4-fortran-legacy.patch:
gfortran.h | 13 +++++++------
gfortran.texi | 9 ++++++++-
invoke.texi | 2 +-
lang.opt | 4 ++++
options.c | 20 ++++++++++++++++----
5 files changed, 36 insertions(+), 12 deletions(-)
--- NEW FILE gcc4-fortran-legacy.patch ---
2005-05-30 Roger Sayle <roger at eyesopen.com>
* gfortran.h (GFC_STD_LEGACY): New "standard" macro. Reindent.
* options.c (gfc_init_options): By default, allow legacy extensions
but warn about them.
(gfc_post_options): Make -pedantic warn about legacy extensions
even with -std=legacy.
(gfc_handle_option): Make -std=gnu follow the default behaviour
of warning about legacy extensions, but allowing them. Make the
new -std=legacy accept everything and warn about nothing.
* lang.opt (std=legacy): New F95 command line option.
* invoke.texi: Document both -std=f2003 and -std=legacy.
* gfortran.texi: Explain the two types of extensions and document
how they are affected by the various -std= command line options.
--- gcc/fortran/gfortran.h 10 May 2005 22:06:43 -0000 1.69
+++ gcc/fortran/gfortran.h 30 May 2005 22:16:08 -0000 1.70
@@ -92,13 +92,14 @@ mstring;
/* Flags to specify which standard/extension contains a feature. */
-#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
-#define GFC_STD_F2003 (1<<4) /* New in F2003. */
+#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */
+#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
+#define GFC_STD_F2003 (1<<4) /* New in F2003. */
/* Note that no features were obsoleted nor deleted in F2003. */
-#define GFC_STD_F95 (1<<3) /* New in F95. */
-#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */
-#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
-#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
+#define GFC_STD_F95 (1<<3) /* New in F95. */
+#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */
+#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
+#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
/*************************** Enums *****************************/
--- gcc/fortran/gfortran.texi 23 May 2005 03:20:19 -0000 1.13
+++ gcc/fortran/gfortran.texi 30 May 2005 22:16:08 -0000 1.14
@@ -618,7 +618,14 @@ Variable for swapping Endianness during
@command{gfortran} implements a number of extensions over standard
Fortran. This chapter contains information on their syntax and
-meaning.
+meaning. There are currently two categories of @command{gfortran}
+extensions, those that provide functionality beyond that provided
+by any standard, and those that are supported by @command{gfortran}
+purely for backward compatibility with legacy compilers. By default,
+ at option{-std=gnu} allows the compiler to accept both types of
+extensions, but to warn about the use of the latter. Specifying
+either @option{-std=f95} or @option{-std=f2003} disables both types
+of extensions, and @option{-std=legacy} allows both without warning.
@menu
* Old-style kind specifications::
--- gcc/fortran/invoke.texi 10 May 2005 22:12:04 -0000 1.14
+++ gcc/fortran/invoke.texi 30 May 2005 22:16:08 -0000 1.15
@@ -248,7 +248,7 @@ Specify that no implicit typing is allow
@cindex option, -std=@var{std}
@item -std=@var{std}
Conform to the specified standard. Allowed values for @var{std} are
- at samp{gnu} and @samp{f95}.
+ at samp{gnu}, @samp{f95}, @samp{f2003} and @samp{legacy}.
@end table
--- gcc/fortran/lang.opt 10 May 2005 22:06:43 -0000 1.12
+++ gcc/fortran/lang.opt 30 May 2005 22:16:08 -0000 1.13
@@ -161,4 +161,8 @@ std=gnu
F95
Conform nothing in particular.
+std=legacy
+F95
+Accept extensions to support legacy code.
+
; This comment is to ensure we retain the blank line above.
--- gcc/fortran/options.c 10 May 2005 22:06:43 -0000 1.19
+++ gcc/fortran/options.c 30 May 2005 22:16:08 -0000 1.20
@@ -77,9 +77,10 @@ gfc_init_options (unsigned int argc ATTR
flag_errno_math = 0;
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
- | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU;
+ | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU
+ | GFC_STD_LEGACY;
gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
- | GFC_STD_F2003;
+ | GFC_STD_F2003 | GFC_STD_LEGACY;
gfc_option.warn_nonstd_intrinsics = 0;
@@ -113,6 +114,9 @@ gfc_post_options (const char **pfilename
/* If -pedantic, warn about the use of GNU extensions. */
if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
gfc_option.warn_std |= GFC_STD_GNU;
+ /* -std=legacy -pedantic is effectively -std=gnu. */
+ if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+ gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
/* If the user didn't explicitly specify -f(no)-second-underscore we
use it if we're trying to be compatible with f2c, and not
@@ -333,8 +337,16 @@ gfc_handle_option (size_t scode, const c
case OPT_std_gnu:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
| GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
- | GFC_STD_GNU;
- gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL;
+ | GFC_STD_GNU | GFC_STD_LEGACY;
+ gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+ | GFC_STD_LEGACY;
+ break;
+
+ case OPT_std_legacy:
+ gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+ | GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F2003
+ | GFC_STD_GNU | GFC_STD_LEGACY;
+ gfc_option.warn_std = 0;
break;
case OPT_Wnonstd_intrinsics:
gcc4-fortran-logical-integer.patch:
fortran/arith.c | 23 ++++++++++++++++++++
fortran/arith.h | 2 +
fortran/gfortran.texi | 17 +++++++++++++++
fortran/intrinsic.c | 44 +++++++++++++++++++++++++--------------
fortran/simplify.c | 17 ++++++++++++---
testsuite/gfortran.dg/logint-1.f | 43 ++++++++++++++++++++++++++++++++++++++
testsuite/gfortran.dg/logint-2.f | 43 ++++++++++++++++++++++++++++++++++++++
testsuite/gfortran.dg/logint-3.f | 43 ++++++++++++++++++++++++++++++++++++++
8 files changed, 214 insertions(+), 18 deletions(-)
--- NEW FILE gcc4-fortran-logical-integer.patch ---
2005-06-01 Roger Sayle <roger at eyesopen.com>
* intrinsic.c (add_conv): No longer take a "simplify" argument as
its always gfc_convert_constant, instead take a "standard" argument.
(add_conversions): Change all existing calls of add_conv to pass
GFC_STD_F77 as appropriate. Additionally, if we're allowing GNU
extensions support integer-logical and logical-integer conversions.
(gfc_convert_type_warn): Warn about use the use of these conversions
as a extension when appropriate, i.e. with -pedantic.
* simplify.c (gfc_convert_constant): Add support for integer to
logical and logical to integer conversions, using gfc_int2log and
gfc_log2int.
* arith.c (gfc_log2int, gfc_int2log): New functions.
* arith.h (gfc_log2int, gfc_int2log): Prototype here.
* gfortran.texi: Document this new GNU extension.
* gfortran.dg/logint-1.f: New test case.
* gfortran.dg/logint-2.f: Likewise.
* gfortran.dg/logint-3.f: Likewise.
--- gcc/fortran/intrinsic.c 25 Apr 2005 00:08:59 -0000 1.46
+++ gcc/fortran/intrinsic.c 1 Jun 2005 19:17:32 -0000 1.47
@@ -2227,8 +2227,7 @@ add_subroutines (void)
/* Add a function to the list of conversion symbols. */
static void
-add_conv (bt from_type, int from_kind, bt to_type, int to_kind,
- gfc_expr * (*simplify) (gfc_expr *, bt, int))
+add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
{
gfc_typespec from, to;
@@ -2250,9 +2249,10 @@ add_conv (bt from_type, int from_kind, b
sym = conversion + nconv;
- sym->name = conv_name (&from, &to);
+ sym->name = conv_name (&from, &to);
sym->lib_name = sym->name;
- sym->simplify.cc = simplify;
+ sym->simplify.cc = gfc_convert_constant;
+ sym->standard = standard;
sym->elemental = 1;
sym->ts = to;
sym->generic_id = GFC_ISYM_CONVERSION;
@@ -2277,7 +2277,7 @@ add_conversions (void)
continue;
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
- BT_INTEGER, gfc_integer_kinds[j].kind, gfc_convert_constant);
+ BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
}
/* Integer-Real/Complex conversions. */
@@ -2285,16 +2285,16 @@ add_conversions (void)
for (j = 0; gfc_real_kinds[j].kind != 0; j++)
{
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
- BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_REAL, gfc_real_kinds[j].kind,
- BT_INTEGER, gfc_integer_kinds[i].kind, gfc_convert_constant);
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
- BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
- BT_INTEGER, gfc_integer_kinds[i].kind, gfc_convert_constant);
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
}
/* Real/Complex - Real/Complex conversions. */
@@ -2304,17 +2304,17 @@ add_conversions (void)
if (i != j)
{
add_conv (BT_REAL, gfc_real_kinds[i].kind,
- BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
- BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
}
add_conv (BT_REAL, gfc_real_kinds[i].kind,
- BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
- BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
+ BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
}
/* Logical/Logical kind conversion. */
@@ -2325,8 +2325,19 @@ add_conversions (void)
continue;
add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
- BT_LOGICAL, gfc_logical_kinds[j].kind, gfc_convert_constant);
+ BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
}
+
+ /* Integer-Logical and Logical-Integer conversions. */
+ if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+ for (i=0; gfc_integer_kinds[i].kind; i++)
+ for (j=0; gfc_logical_kinds[j].kind; j++)
+ {
+ add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+ BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
+ add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ }
}
@@ -3142,7 +3153,10 @@ gfc_convert_type_warn (gfc_expr * expr,
goto bad;
/* At this point, a conversion is necessary. A warning may be needed. */
- if (wflag && gfc_option.warn_conversion)
+ if ((gfc_option.warn_std & sym->standard) != 0)
+ gfc_warning_now ("Extension: Conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
+ else if (wflag && gfc_option.warn_conversion)
gfc_warning_now ("Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
--- gcc/fortran/simplify.c 14 Apr 2005 16:29:31 -0000 1.25
+++ gcc/fortran/simplify.c 1 Jun 2005 19:17:32 -0000 1.26
@@ -3659,6 +3659,9 @@ gfc_convert_constant (gfc_expr * e, bt t
case BT_COMPLEX:
f = gfc_int2complex;
break;
+ case BT_LOGICAL:
+ f = gfc_int2log;
+ break;
default:
goto oops;
}
@@ -3700,9 +3703,17 @@ gfc_convert_constant (gfc_expr * e, bt t
break;
case BT_LOGICAL:
- if (type != BT_LOGICAL)
- goto oops;
- f = gfc_log2log;
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_log2int;
+ break;
+ case BT_LOGICAL:
+ f = gfc_log2log;
+ break;
+ default:
+ goto oops;
+ }
break;
default:
--- gcc/fortran/arith.c 28 May 2005 18:28:31 -0000 1.27
+++ gcc/fortran/arith.c 1 Jun 2005 19:17:32 -0000 1.28
@@ -2191,3 +2191,26 @@ gfc_log2log (gfc_expr * src, int kind)
return result;
}
+
+/* Convert logical to integer. */
+
+gfc_expr *
+gfc_log2int (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_constant_result (BT_INTEGER, kind, &src->where);
+ mpz_set_si (result->value.integer, src->value.logical);
+ return result;
+}
+
+/* Convert integer to logical. */
+
+gfc_expr *
+gfc_int2log (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_constant_result (BT_LOGICAL, kind, &src->where);
+ result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
+ return result;
+}
+
--- gcc/fortran/arith.h 6 Aug 2004 20:36:04 -0000 1.4
+++ gcc/fortran/arith.h 1 Jun 2005 19:17:33 -0000 1.5
@@ -80,6 +80,8 @@ gfc_expr *gfc_complex2int (gfc_expr *, i
gfc_expr *gfc_complex2real (gfc_expr *, int);
gfc_expr *gfc_complex2complex (gfc_expr *, int);
gfc_expr *gfc_log2log (gfc_expr *, int);
+gfc_expr *gfc_log2int (gfc_expr *, int);
+gfc_expr *gfc_int2log (gfc_expr *, int);
#endif /* GFC_ARITH_H */
--- gcc/fortran/gfortran.texi 30 May 2005 22:16:08 -0000 1.14
+++ gcc/fortran/gfortran.texi 1 Jun 2005 19:17:33 -0000 1.15
@@ -636,6 +636,7 @@ of extensions, and @option{-std=legacy}
* Old-style kind specifications::
* Old-style variable initialization::
* Extensions to namelist::
+* Implicitly interconvert LOGICAL and INTEGER::
@end menu
@node Old-style kind specifications
@@ -732,6 +733,22 @@ had been called:
To aid this dialog, when input is from stdin, errors produce send their
messages to stderr and execution continues, even if IOSTAT is set.
+ at node Implicitly interconvert LOGICAL and INTEGER
+ at section Implicitly interconvert LOGICAL and INTEGER
+ at cindex Implicitly interconvert LOGICAL and INTEGER
+
+As a GNU extension for backwards compatability with other compilers,
+ at command{gfortran} allows the implicit conversion of LOGICALs to INTEGERs
+and vice versa. When converting from a LOGICAL to an INTEGER, the numeric
+value of @code{.FALSE.} is zero, and that of @code{.TRUE.} is one. When
+converting from INTEGER to LOGICAL, the value zero is interpreted as
+ at code{.FALSE.} and any non-zero value is interpreted as @code{.TRUE.}.
+
+ at smallexample
+ INTEGER*4 i
+ i = .FALSE.
+ at end smallexample
+
@include intrinsic.texi
@c ---------------------------------------------------------------------
@c Contributing
--- gcc/testsuite/gfortran.dg/logint-1.f 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/logint-1.f 1 Jun 2005 19:17:37 -0000 1.1
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2 -std=legacy" }
+ LOGICAL*1 l1
+ LOGICAL*2 l2
+ LOGICAL*4 l4
+ INTEGER*1 i1
+ INTEGER*2 i2
+ INTEGER*4 i4
+
+ i1 = .TRUE.
+ i2 = .TRUE.
+ i4 = .TRUE.
+
+ i1 = .FALSE.
+ i2 = .FALSE.
+ i4 = .FALSE.
+
+ i1 = l1
+ i2 = l1
+ i4 = l1
+
+ i1 = l2
+ i2 = l2
+ i4 = l2
+
+ i1 = l4
+ i2 = l4
+ i4 = l4
+
+ l1 = i1
+ l2 = i1
+ l4 = i1
+
+ l1 = i2
+ l2 = i2
+ l4 = i2
+
+ l1 = i4
+ l2 = i4
+ l4 = i4
+
+ END
+
--- gcc/testsuite/gfortran.dg/logint-2.f 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/logint-2.f 1 Jun 2005 19:17:37 -0000 1.1
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2 -std=f95" }
+ LOGICAL*1 l1
+ LOGICAL*2 l2
+ LOGICAL*4 l4
+ INTEGER*1 i1
+ INTEGER*2 i2
+ INTEGER*4 i4
+
+ i1 = .TRUE. ! { dg-error "convert" }
+ i2 = .TRUE. ! { dg-error "convert" }
+ i4 = .TRUE. ! { dg-error "convert" }
+
+ i1 = .FALSE. ! { dg-error "convert" }
+ i2 = .FALSE. ! { dg-error "convert" }
+ i4 = .FALSE. ! { dg-error "convert" }
+
+ i1 = l1 ! { dg-error "convert" }
+ i2 = l1 ! { dg-error "convert" }
+ i4 = l1 ! { dg-error "convert" }
+
+ i1 = l2 ! { dg-error "convert" }
+ i2 = l2 ! { dg-error "convert" }
+ i4 = l2 ! { dg-error "convert" }
+
+ i1 = l4 ! { dg-error "convert" }
+ i2 = l4 ! { dg-error "convert" }
+ i4 = l4 ! { dg-error "convert" }
+
+ l1 = i1 ! { dg-error "convert" }
+ l2 = i1 ! { dg-error "convert" }
+ l4 = i1 ! { dg-error "convert" }
+
+ l1 = i2 ! { dg-error "convert" }
+ l2 = i2 ! { dg-error "convert" }
+ l4 = i2 ! { dg-error "convert" }
+
+ l1 = i4 ! { dg-error "convert" }
+ l2 = i4 ! { dg-error "convert" }
+ l4 = i4 ! { dg-error "convert" }
+
+ END
+
--- gcc/testsuite/gfortran.dg/logint-3.f 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/logint-3.f 1 Jun 2005 19:17:37 -0000 1.1
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2" }
+ LOGICAL*1 l1
+ LOGICAL*2 l2
+ LOGICAL*4 l4
+ INTEGER*1 i1
+ INTEGER*2 i2
+ INTEGER*4 i4
+
+ i1 = .TRUE. ! { dg-warning "Extension: Conversion" }
+ i2 = .TRUE. ! { dg-warning "Extension: Conversion" }
+ i4 = .TRUE. ! { dg-warning "Extension: Conversion" }
+
+ i1 = .FALSE. ! { dg-warning "Extension: Conversion" }
+ i2 = .FALSE. ! { dg-warning "Extension: Conversion" }
+ i4 = .FALSE. ! { dg-warning "Extension: Conversion" }
+
+ i1 = l1 ! { dg-warning "Extension: Conversion" }
+ i2 = l1 ! { dg-warning "Extension: Conversion" }
+ i4 = l1 ! { dg-warning "Extension: Conversion" }
+
+ i1 = l2 ! { dg-warning "Extension: Conversion" }
+ i2 = l2 ! { dg-warning "Extension: Conversion" }
+ i4 = l2 ! { dg-warning "Extension: Conversion" }
+
+ i1 = l4 ! { dg-warning "Extension: Conversion" }
+ i2 = l4 ! { dg-warning "Extension: Conversion" }
+ i4 = l4 ! { dg-warning "Extension: Conversion" }
+
+ l1 = i1 ! { dg-warning "Extension: Conversion" }
+ l2 = i1 ! { dg-warning "Extension: Conversion" }
+ l4 = i1 ! { dg-warning "Extension: Conversion" }
+
+ l1 = i2 ! { dg-warning "Extension: Conversion" }
+ l2 = i2 ! { dg-warning "Extension: Conversion" }
+ l4 = i2 ! { dg-warning "Extension: Conversion" }
+
+ l1 = i4 ! { dg-warning "Extension: Conversion" }
+ l2 = i4 ! { dg-warning "Extension: Conversion" }
+ l4 = i4 ! { dg-warning "Extension: Conversion" }
+
+ END
+
gcc4-fortran-rh161634.patch:
fortran/decl.c | 2 -
testsuite/gfortran.fortran-torture/execute/entry_9.f90 | 24 +++++++++++++++++
2 files changed, 25 insertions(+), 1 deletion(-)
--- NEW FILE gcc4-fortran-rh161634.patch ---
2005-07-07 Jakub Jelinek <jakub at redhat.com>
* decl.c (gfc_match_entry): Allow ENTRY without parentheses
even in FUNCTIONs.
* gfortran.fortran-torture/execute/entry_9.f90: New test.
--- gcc/fortran/decl.c 25 Jun 2005 00:40:34 -0000 1.36
+++ gcc/fortran/decl.c 6 Jul 2005 22:12:12 -0000 1.37
@@ -2395,7 +2395,7 @@ gfc_match_entry (void)
else
{
/* An entry in a function. */
- m = gfc_match_formal_arglist (entry, 0, 0);
+ m = gfc_match_formal_arglist (entry, 0, 1);
if (m != MATCH_YES)
return MATCH_ERROR;
--- gcc/testsuite/gfortran.fortran-torture/execute/entry_9.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.fortran-torture/execute/entry_9.f90 6 Jul 2005 22:12:25 -0000 1.1
@@ -0,0 +1,24 @@
+! Test alternate entry points for functions when the result types
+! of all entry points match
+
+ function f1 (a)
+ integer a, f1, e1
+ f1 = 15 + a
+ return
+ entry e1
+ e1 = 42
+ end function
+ function f2 ()
+ real f2, e2
+ entry e2
+ e2 = 45
+ end function
+
+ program entrytest
+ integer f1, e1
+ real f2, e2
+ if (f1 (6) .ne. 21) call abort ()
+ if (e1 () .ne. 42) call abort ()
+ if (f2 () .ne. 45) call abort ()
+ if (e2 () .ne. 45) call abort ()
+ end
gcc4-fortran-rh161669.patch:
fortran/primary.c | 21 ++++++++++++----
testsuite/gfortran.fortran-torture/execute/entry_10.f90 | 13 +++++++++
2 files changed, 30 insertions(+), 4 deletions(-)
--- NEW FILE gcc4-fortran-rh161669.patch ---
2005-07-08 Jakub Jelinek <jakub at redhat.com>
* primary.c (gfc_match_rvalue): Handle ENTRY the same way
as FUNCTION.
* gfortran.fortran-torture/execute/entry_10.f90: New test.
--- gcc/fortran/primary.c 7 Jul 2005 11:59:29 -0000 1.30
+++ gcc/fortran/primary.c 8 Jul 2005 10:06:36 -0000 1.31
@@ -1846,11 +1846,24 @@ gfc_match_rvalue (gfc_expr ** result)
gfc_set_sym_referenced (sym);
- if (sym->attr.function && sym->result == sym
- && (gfc_current_ns->proc_name == sym
+ if (sym->attr.function && sym->result == sym)
+ {
+ if (gfc_current_ns->proc_name == sym
|| (gfc_current_ns->parent != NULL
- && gfc_current_ns->parent->proc_name == sym)))
- goto variable;
+ && gfc_current_ns->parent->proc_name == sym))
+ goto variable;
+
+ if (sym->attr.entry
+ && (sym->ns == gfc_current_ns
+ || sym->ns == gfc_current_ns->parent))
+ {
+ gfc_entry_list *el = NULL;
+
+ for (el = sym->ns->entries; el; el = el->next)
+ if (sym == el->sym)
+ goto variable;
+ }
+ }
if (sym->attr.function || sym->attr.external || sym->attr.intrinsic)
goto function0;
--- gcc/testsuite/gfortran.fortran-torture/execute/entry_10.f90 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.fortran-torture/execute/entry_10.f90 8 Jul 2005 10:06:57 -0000 1.1
@@ -0,0 +1,13 @@
+ function foo ()
+ foo = 4
+ foo = foo / 2
+ return
+ entry bar ()
+ bar = 9
+ bar = bar / 3
+ end
+
+ program entrytest
+ if (foo () .ne. 2) call abort ()
+ if (bar () .ne. 3) call abort ()
+ end
gcc4-fortran-rh161679.patch:
fortran/scanner.c | 40 ++++++++++++++++++++++++----------------
testsuite/gfortran.dg/badline.f | 4 ++++
2 files changed, 28 insertions(+), 16 deletions(-)
--- NEW FILE gcc4-fortran-rh161679.patch ---
2005-07-07 Jakub Jelinek <jakub at redhat.com>
* scanner.c (preprocessor_line): Only set current_file->line when errors
have not been encountered. Warn and don't crash if a file leave
preprocessor line has no corresponding entering line. Formatting.
* gfortran.dg/badline.f: New test.
--- gcc/fortran/scanner.c 25 Jun 2005 00:40:35 -0000 1.19
+++ gcc/fortran/scanner.c 7 Jul 2005 15:55:45 -0000 1.20
@@ -839,15 +839,13 @@ preprocessor_line (char *c)
line = atoi (c);
- /* Set new line number. */
- current_file->line = line;
-
- c = strchr (c, ' ');
+ c = strchr (c, ' ');
if (c == NULL)
- /* No file name given. */
- return;
-
-
+ {
+ /* No file name given. Set new line number. */
+ current_file->line = line;
+ return;
+ }
/* Skip spaces. */
while (*c == ' ' || *c == '\t')
@@ -880,7 +878,7 @@ preprocessor_line (char *c)
/* Get flags. */
-
+
flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
for (;;)
@@ -895,24 +893,32 @@ preprocessor_line (char *c)
if (1 <= i && i <= 4)
flag[i] = true;
}
-
+
/* Interpret flags. */
-
+
if (flag[1] || flag[3]) /* Starting new file. */
{
f = get_file (filename, LC_RENAME);
f->up = current_file;
current_file = f;
}
-
+
if (flag[2]) /* Ending current file. */
{
- current_file = current_file->up;
+ if (strcmp (current_file->filename, filename) != 0)
+ {
+ gfc_warning_now ("%s:%d: file %s left but not entered",
+ current_file->filename, current_file->line,
+ filename);
+ return;
+ }
+ if (current_file->up)
+ current_file = current_file->up;
}
-
+
/* The name of the file can be a temporary file produced by
cpp. Replace the name if it is different. */
-
+
if (strcmp (current_file->filename, filename) != 0)
{
gfc_free (current_file->filename);
@@ -920,10 +926,12 @@ preprocessor_line (char *c)
strcpy (current_file->filename, filename);
}
+ /* Set new line number. */
+ current_file->line = line;
return;
bad_cpp_line:
- gfc_warning_now ("%s:%d: Illegal preprocessor directive",
+ gfc_warning_now ("%s:%d: Illegal preprocessor directive",
current_file->filename, current_file->line);
current_file->line++;
}
--- gcc/testsuite/gfortran.dg/badline.f 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/badline.f 7 Jul 2005 15:55:53 -0000 1.1
@@ -0,0 +1,4 @@
+ subroutine foo
+# 18 "src/badline.F" 2
+ end
+! { dg-warning "left but not entered" "" { target *-*-* } 2 }
gcc4-fortran-rh161680.patch:
fortran/scanner.c | 30 +++++++++++++++++-------------
testsuite/gfortran.dg/longline.f | 10 ++++++++++
2 files changed, 27 insertions(+), 13 deletions(-)
--- NEW FILE gcc4-fortran-rh161680.patch ---
2005-07-07 Jakub Jelinek <jakub at redhat.com>
* scanner.c (load_line): Add pbuflen argument, don't make
buflen static. If maxlen == 0 or preprocessor_flag,
don't truncate at buflen, but at maxlen. In xrealloc add
1 byte at the end for the terminating '\0'. Don't fill
with spaces up to buflen, but gfc_option.fixed_line_length.
(load_file): Adjust load_line caller. Add line_len variable.
* gfortran.dg/longline.f: New test.
--- gcc/fortran/scanner.c 7 Jul 2005 15:55:45 -0000 1.20
+++ gcc/fortran/scanner.c 7 Jul 2005 15:58:03 -0000 1.21
@@ -683,11 +683,10 @@ gfc_gobble_whitespace (void)
load_line returns wether the line was truncated. */
static int
-load_line (FILE * input, char **pbuf)
+load_line (FILE * input, char **pbuf, int *pbuflen)
{
- int c, maxlen, i, preprocessor_flag;
+ int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0;
- static int buflen = 0;
char *buffer;
/* Determine the maximum allowed line length. */
@@ -753,15 +752,18 @@ load_line (FILE * input, char **pbuf)
*buffer++ = c;
i++;
- if (i >= buflen && (maxlen == 0 || preprocessor_flag))
+ if (maxlen == 0 || preprocessor_flag)
{
- /* Reallocate line buffer to double size to hold the
- overlong line. */
- buflen = buflen * 2;
- *pbuf = xrealloc (*pbuf, buflen);
- buffer = (*pbuf)+i;
+ if (i >= buflen)
+ {
+ /* Reallocate line buffer to double size to hold the
+ overlong line. */
+ buflen = buflen * 2;
+ *pbuf = xrealloc (*pbuf, buflen + 1);
+ buffer = (*pbuf)+i;
+ }
}
- else if (i >= buflen)
+ else if (i >= maxlen)
{
/* Truncate the rest of the line. */
for (;;)
@@ -782,10 +784,11 @@ load_line (FILE * input, char **pbuf)
&& gfc_option.fixed_line_length > 0
&& !preprocessor_flag
&& c != EOF)
- while (i++ < buflen)
+ while (i++ < gfc_option.fixed_line_length)
*buffer++ = ' ';
*buffer = '\0';
+ *pbuflen = buflen;
return trunc_flag;
}
@@ -1001,7 +1004,7 @@ load_file (char *filename, bool initial)
gfc_linebuf *b;
gfc_file *f;
FILE *input;
- int len;
+ int len, line_len;
for (f = current_file; f; f = f->up)
if (strcmp (filename, f->filename) == 0)
@@ -1036,10 +1039,11 @@ load_file (char *filename, bool initial)
current_file = f;
current_file->line = 1;
line = NULL;
+ line_len = 0;
for (;;)
{
- int trunc = load_line (input, &line);
+ int trunc = load_line (input, &line, &line_len);
len = strlen (line);
if (feof (input) && len == 0)
--- gcc/testsuite/gfortran.dg/longline.f 1 Jan 1970 00:00:00 -0000
+++ gcc/testsuite/gfortran.dg/longline.f 7 Jul 2005 15:58:16 -0000 1.1
@@ -0,0 +1,10 @@
+# 1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.f"
+! { dg-do compile }
+
+ subroutine foo
+ character*10 cpnam
+ character*4 csig
+ write (34,808) csig,ilax,cpnam
+ 808 format (/9X,4HTHE ,A4, 29HTIVE MINOS ERROR OF PARAMETER,I3, 2H
+ +, ,A10)
+ end
gcc4-i386-masm=intel.patch:
i386.c | 2 +-
1 files changed, 1 insertion(+), 1 deletion(-)
--- NEW FILE gcc4-i386-masm=intel.patch ---
2005-07-06 Jakub Jelinek <jakub at redhat.com>
* config/i386/i386.c (output_set_got): Don't omit OFFSET FLAT:
in Intel syntax add %reg, OFFSET FLAT:_GLOBAL_OFFSET_TABLE_+(.-.Lx).
--- gcc/config/i386/i386.c.jj 2005-07-03 13:53:06.000000000 +0200
+++ gcc/config/i386/i386.c 2005-07-06 18:24:52.000000000 +0200
@@ -4175,7 +4175,7 @@ output_set_got (rtx dest)
if (!flag_pic || TARGET_DEEP_BRANCH_PREDICTION)
output_asm_insn ("add{l}\t{%1, %0|%0, %1}", xops);
else if (!TARGET_MACHO)
- output_asm_insn ("add{l}\t{%1+[.-%a2], %0|%0, %a1+(.-%a2)}", xops);
+ output_asm_insn ("add{l}\t{%1+[.-%a2], %0|%0, %1+(.-%a2)}", xops);
return "";
}
gcc4-ia64-stack-protector.patch:
ia64.c | 27 ++++++++++-----------------
ia64.h | 2 +-
ia64.md | 37 +++++++++++++++++++++++++++++++++++++
linux.h | 5 +++++
4 files changed, 53 insertions(+), 18 deletions(-)
--- NEW FILE gcc4-ia64-stack-protector.patch ---
2005-07-08 Jakub Jelinek <jakub at redhat.com>
* config/ia64/ia64.h (FRAME_GROWS_DOWNWARD): Define to 1 if
-fstack-protect.
* config/ia64/ia64.c (ia64_compute_frame_size): Make sure
size is a multiple of 16 if FRAME_GROWS_DOWNWARD.
(ia64_initial_elimination_offset): Support FRAME_GROWS_DOWNWARD
layout.
* config/ia64/linux.h (TARGET_LIBC_PROVIDES_SSP): Define.
* config/ia64/ia64.md (stack_protect_set, stack_protect_test): New
expanders.
--- gcc/config/ia64/linux.h.jj 2005-02-28 12:11:03.000000000 +0100
+++ gcc/config/ia64/linux.h 2005-07-08 18:19:37.000000000 +0200
@@ -58,3 +58,8 @@ do { \
#define LINK_EH_SPEC ""
#define MD_UNWIND_SUPPORT "config/ia64/linux-unwind.h"
+
+#ifdef TARGET_LIBC_PROVIDES_SSP
+/* IA-64 glibc provides __stack_chk_guard in [r13-8]. */
+#define TARGET_THREAD_SSP_OFFSET -8
+#endif
--- gcc/config/ia64/ia64.c.jj 2005-07-08 16:14:51.000000000 +0200
+++ gcc/config/ia64/ia64.c 2005-07-08 18:17:40.000000000 +0200
@@ -2165,6 +2165,9 @@ ia64_compute_frame_size (HOST_WIDE_INT s
else
pretend_args_size = current_function_pretend_args_size;
+ if (FRAME_GROWS_DOWNWARD)
+ size = IA64_STACK_ALIGN (size);
+
total_size = (spill_size + extra_spill_size + size + pretend_args_size
+ current_function_outgoing_args_size);
total_size = IA64_STACK_ALIGN (total_size);
@@ -2189,28 +2192,18 @@ ia64_compute_frame_size (HOST_WIDE_INT s
HOST_WIDE_INT
ia64_initial_elimination_offset (int from, int to)
{
- HOST_WIDE_INT offset;
+ HOST_WIDE_INT offset, size = get_frame_size ();
- ia64_compute_frame_size (get_frame_size ());
+ ia64_compute_frame_size (size);
switch (from)
{
case FRAME_POINTER_REGNUM:
+ offset = FRAME_GROWS_DOWNWARD ? IA64_STACK_ALIGN (size) : 0;
+ if (!current_function_is_leaf)
+ offset += 16 + current_function_outgoing_args_size;
if (to == HARD_FRAME_POINTER_REGNUM)
- {
- if (current_function_is_leaf)
- offset = -current_frame_info.total_size;
- else
- offset = -(current_frame_info.total_size
- - current_function_outgoing_args_size - 16);
- }
- else if (to == STACK_POINTER_REGNUM)
- {
- if (current_function_is_leaf)
- offset = 0;
- else
- offset = 16 + current_function_outgoing_args_size;
- }
- else
+ offset = -current_frame_info.total_size;
+ else if (to != STACK_POINTER_REGNUM)
abort ();
break;
--- gcc/config/ia64/ia64.md.jj 2005-05-16 23:32:52.000000000 +0200
+++ gcc/config/ia64/ia64.md 2005-07-08 18:39:59.000000000 +0200
@@ -6248,5 +6248,42 @@
"addp4 %0 = %1, %2"
[(set_attr "itanium_class" "ialu")])
+;;
+;; Stack guard expanders
+
+(define_expand "stack_protect_set"
+ [(set (match_operand 0 "memory_operand" "")
+ (match_operand 1 "memory_operand" ""))]
+ ""
+{
+#ifdef TARGET_THREAD_SSP_OFFSET
+ rtx thread_pointer_rtx = gen_rtx_REG (Pmode, 13);
+ rtx canary = gen_rtx_MEM (Pmode, gen_rtx_PLUS (Pmode, thread_pointer_rtx,
+ GEN_INT (TARGET_THREAD_SSP_OFFSET)));
+ MEM_VOLATILE_P (canary) = MEM_VOLATILE_P (operands[1]);
+ operands[1] = canary;
+#endif
+ emit_move_insn (operands[0], operands[1]);
+ DONE;
+})
+
+(define_expand "stack_protect_test"
+ [(match_operand 0 "memory_operand" "")
+ (match_operand 1 "memory_operand" "")
+ (match_operand 2 "" "")]
+ ""
+{
+#ifdef TARGET_THREAD_SSP_OFFSET
+ rtx thread_pointer_rtx = gen_rtx_REG (Pmode, 13);
+ rtx canary = gen_rtx_MEM (Pmode, gen_rtx_PLUS (Pmode, thread_pointer_rtx,
+ GEN_INT (TARGET_THREAD_SSP_OFFSET)));
+ MEM_VOLATILE_P (canary) = MEM_VOLATILE_P (operands[1]);
+ operands[1] = canary;
+#endif
+ emit_cmp_and_jump_insns (operands[0], operands[1], EQ, NULL_RTX,
+ ptr_mode, 1, operands[2]);
+ DONE;
+})
+
;; Vector operations
(include "vect.md")
--- gcc/config/ia64/ia64.h.jj 2005-07-08 16:36:20.000000000 +0200
+++ gcc/config/ia64/ia64.h 2005-07-08 18:11:34.000000000 +0200
@@ -1120,7 +1120,7 @@ enum reg_class
/* Define this macro to non-zero if the addresses of local variable slots
are at negative offsets from the frame pointer. */
-#define FRAME_GROWS_DOWNWARD 0
+#define FRAME_GROWS_DOWNWARD (flag_stack_protect != 0)
/* Offset from the frame pointer to the first local variable slot to
be allocated. */
gcc4-libstdc++-pr22309.patch:
mt_allocator.cc | 22 +++++++++++++++-------
1 files changed, 15 insertions(+), 7 deletions(-)
--- NEW FILE gcc4-libstdc++-pr22309.patch ---
2005-07-07 Jakub Jelinek <jakub at redhat.com>
PR libstdc++/22309
* src/mt_allocator.cc (__gnu_internal::__freelist_key): New type.
(__gnu_internal::freelist_key): Change to the above type.
(_M_initialize, _M_get_thread_id): Adjust users.
--- libstdc++-v3/src/mt_allocator.cc.jj 2005-06-07 12:31:09.000000000 +0200
+++ libstdc++-v3/src/mt_allocator.cc 2005-07-07 19:43:31.000000000 +0200
@@ -1,8 +1,8 @@
// Allocator details.
-// Copyright (C) 2004 Free Software Foundation, Inc.
+// Copyright (C) 2004, 2005 Free Software Foundation, Inc.
//
-// This file is part of the GNU ISO C++ Librarbooly. This library is free
+// This file is part of the GNU ISO C++ Library. This library is free
// software; you can redistribute it and/or modify it under the
// terms of the GNU General Public License as published by the
// Free Software Foundation; either version 2, or (at your option)
@@ -40,7 +40,14 @@ namespace __gnu_internal
__glibcxx_mutex_define_initialized(freelist_mutex);
#ifdef __GTHREADS
- __gthread_key_t freelist_key;
+ struct __freelist_key
+ {
+ bool _M_init;
+ __gthread_key_t _M_key;
+ ~__freelist_key() { if (_M_init) __gthread_key_delete (_M_key); }
+ } freelist_key
+ /* Ensure freelist_key is destructed last. */
+ __attribute__((init_priority (101)));
#endif
}
@@ -454,8 +461,9 @@ namespace __gnu_cxx
// Initialize per thread key to hold pointer to
// _M_thread_freelist.
- __gthread_key_create(&__gnu_internal::freelist_key, __d);
-
+ __gthread_key_create(&__gnu_internal::freelist_key._M_key, __d);
+ __gnu_internal::freelist_key._M_init = true;
+
const size_t __max_threads = _M_options._M_max_threads + 1;
for (size_t __n = 0; __n < _M_bin_size; ++__n)
{
@@ -514,7 +522,7 @@ namespace __gnu_cxx
// returns it's id.
if (__gthread_active_p())
{
- void* v = __gthread_getspecific(__gnu_internal::freelist_key);
+ void* v = __gthread_getspecific(__gnu_internal::freelist_key._M_key);
_Thread_record* __freelist_pos = static_cast<_Thread_record*>(v);
if (__freelist_pos == NULL)
{
@@ -527,7 +535,7 @@ namespace __gnu_cxx
_M_thread_freelist = _M_thread_freelist->_M_next;
}
- __gthread_setspecific(__gnu_internal::freelist_key,
+ __gthread_setspecific(__gnu_internal::freelist_key._M_key,
static_cast<void*>(__freelist_pos));
}
return __freelist_pos->_M_id;
gcc4-s390-stack-protector.patch:
linux.h | 6 ++++
s390.c | 26 ++++++++++++++++--
s390.h | 2 -
s390.md | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
4 files changed, 121 insertions(+), 5 deletions(-)
--- NEW FILE gcc4-s390-stack-protector.patch ---
2005-07-08 Jakub Jelinek <jakub at redhat.com>
* config/s390/linux.h (TARGET_THREAD_SSP_OFFSET): Define.
* config/s390/s390.md (stack_protect_set, stack_protect_test): If
TARGET_THREAD_SSP_OFFSET is defined, change operands[1] to
(MEM:P (PLUS:P (tp, TARGET_THREAD_SSP_OFFSET))).
2005-07-04 Andreas Krebbel <krebbel1 at de.ibm.com>
* config/s390/s390.c (print_operand): New output modifier 'G' added.
* config/s390/s390.md (UNSPEC_SP_SET, UNSPEC_SP_TEST): New constants.
("stack_protect_set", "stack_protect_test"): New expanders.
("stack_protect_setsi", "stack_protect_setdi", "stack_protect_testsi",
"stack_protect_testdi"): New insn definitions.
2005-06-07 Adrian Straetling <straetling at de.ibm.com>
* config/s390/s390.c: (s390_compare_emitted): New global variable.
(s390_emit_compare): Do not emit comparison again after cas.
* config/s390/s390.h (s390_compare_emitted): Declare.
--- gcc/config/s390/linux.h.jj 2004-10-17 20:09:46.000000000 +0200
+++ gcc/config/s390/linux.h 2005-07-08 18:08:27.000000000 +0200
@@ -94,4 +94,10 @@ Software Foundation, 59 Temple Place - S
#define MD_UNWIND_SUPPORT "config/s390/linux-unwind.h"
+#ifdef TARGET_LIBC_PROVIDES_SSP
+/* s390 glibc provides __stack_chk_guard in 0x14(tp),
+ s390x glibc provides it at 0x28(tp). */
+#define TARGET_THREAD_SSP_OFFSET (TARGET_64BIT ? 0x28 : 0x14)
+#endif
+
#endif
--- gcc/config/s390/s390.h.jj 2005-07-08 17:32:28.000000000 +0200
+++ gcc/config/s390/s390.h 2005-07-08 21:56:26.000000000 +0200
@@ -880,7 +880,7 @@ do { \
/* Define the information needed to generate branch and scc insns. This is
stored from the compare operation. Note that we can't use "rtx" here
since it hasn't been defined! */
-extern struct rtx_def *s390_compare_op0, *s390_compare_op1;
+extern struct rtx_def *s390_compare_op0, *s390_compare_op1, *s390_compare_emitted;
/* Relative costs of operations. */
--- gcc/config/s390/s390.md.jj 2005-04-19 17:27:54.000000000 +0200
+++ gcc/config/s390/s390.md 2005-07-08 22:02:39.000000000 +0200
@@ -119,7 +119,11 @@
(UNSPEC_TLS_LOAD 512)
; String Functions
- (UNSPEC_SRST 600)
+ (UNSPEC_SRST 600)
+
+ ; Stack Smashing Protector
+ (UNSPEC_SP_SET 700)
+ (UNSPEC_SP_TEST 701)
])
;;
@@ -8157,3 +8161,89 @@
DONE;
})
+;
+; Stack Protector Patterns
+;
+
+(define_expand "stack_protect_set"
+ [(set (match_operand 0 "memory_operand" "")
+ (match_operand 1 "memory_operand" ""))]
+ ""
+{
+#ifdef TARGET_THREAD_SSP_OFFSET
+ rtx tp = gen_reg_rtx (Pmode);
+
+ emit_move_insn (tp, gen_rtx_REG (Pmode, 36));
+ mark_reg_pointer (tp, BITS_PER_WORD);
+
+ operands[1]
+ = gen_rtx_MEM (Pmode, gen_rtx_PLUS (Pmode, tp,
+ GEN_INT (TARGET_THREAD_SSP_OFFSET)));
+#endif
+ if (TARGET_64BIT)
+ emit_insn (gen_stack_protect_setdi (operands[0], operands[1]));
+ else
+ emit_insn (gen_stack_protect_setsi (operands[0], operands[1]));
+
+ DONE;
+})
+
+(define_insn "stack_protect_setsi"
+ [(set (match_operand:SI 0 "memory_operand" "=Q")
+ (unspec:SI [(match_operand:SI 1 "memory_operand" "Q")] UNSPEC_SP_SET))]
+ ""
+ "mvc\t%O0(%G0,%R0),%S1"
+ [(set_attr "op_type" "SS")])
+
+(define_insn "stack_protect_setdi"
+ [(set (match_operand:DI 0 "memory_operand" "=Q")
+ (unspec:DI [(match_operand:DI 1 "memory_operand" "Q")] UNSPEC_SP_SET))]
+ "TARGET_64BIT"
+ "mvc\t%O0(%G0,%R0),%S1"
+ [(set_attr "op_type" "SS")])
+
+(define_expand "stack_protect_test"
+ [(match_operand 0 "memory_operand" "")
+ (match_operand 1 "memory_operand" "")
+ (match_operand 2 "" "")]
+ ""
+{
+#ifdef TARGET_THREAD_SSP_OFFSET
+ rtx tp = gen_reg_rtx (Pmode);
+
+ emit_move_insn (tp, gen_rtx_REG (Pmode, 36));
+ mark_reg_pointer (tp, BITS_PER_WORD);
+
+ operands[1]
+ = gen_rtx_MEM (Pmode, gen_rtx_PLUS (Pmode, tp,
+ GEN_INT (TARGET_THREAD_SSP_OFFSET)));
+#endif
+ s390_compare_op0 = operands[0];
+ s390_compare_op1 = operands[1];
+ s390_compare_emitted = gen_rtx_REG (CCZmode, 33);
+
+ if (TARGET_64BIT)
+ emit_insn (gen_stack_protect_testdi (operands[0], operands[1]));
+ else
+ emit_insn (gen_stack_protect_testsi (operands[0], operands[1]));
+
+ emit_jump_insn (gen_beq (operands[2]));
+ DONE;
+})
+
+(define_insn "stack_protect_testsi"
+ [(set (reg:CCZ 33)
+ (unspec:CCZ [(match_operand:SI 0 "memory_operand" "Q")
+ (match_operand:SI 1 "memory_operand" "Q")] UNSPEC_SP_TEST))]
+ ""
+ "clc\t%O0(%G0,%R0),%S1"
+ [(set_attr "op_type" "SS")])
+
+(define_insn "stack_protect_testdi"
+ [(set (reg:CCZ 33)
+ (unspec:CCZ [(match_operand:DI 0 "memory_operand" "Q")
+ (match_operand:DI 1 "memory_operand" "Q")] UNSPEC_SP_TEST))]
+ "TARGET_64BIT"
+ "clc\t%O0(%G0,%R0),%S1"
+ [(set_attr "op_type" "SS")])
+
--- gcc/config/s390/s390.c.jj 2005-07-08 17:32:28.000000000 +0200
+++ gcc/config/s390/s390.c 2005-07-08 21:56:26.000000000 +0200
@@ -278,6 +278,10 @@ static int s390_sr_alias_set = 0;
emitted. */
rtx s390_compare_op0, s390_compare_op1;
+/* Save the result of a compare_and_swap until the branch or scc is
+ emitted. */
+rtx s390_compare_emitted = NULL_RTX;
+
/* Structure used to hold the components of a S/390 memory
address. A legitimate address on S/390 is of the general
form
@@ -769,10 +773,21 @@ rtx
s390_emit_compare (enum rtx_code code, rtx op0, rtx op1)
{
enum machine_mode mode = s390_select_ccmode (code, op0, op1);
- rtx cc = gen_rtx_REG (mode, CC_REGNUM);
+ rtx ret = NULL_RTX;
- emit_insn (gen_rtx_SET (VOIDmode, cc, gen_rtx_COMPARE (mode, op0, op1)));
- return gen_rtx_fmt_ee (code, VOIDmode, cc, const0_rtx);
+ /* Do not output a redundant compare instruction if a compare_and_swap
+ pattern already computed the result and the machine modes match. */
+ if (s390_compare_emitted && GET_MODE (s390_compare_emitted) == mode)
+ ret = gen_rtx_fmt_ee (code, VOIDmode, s390_compare_emitted, const0_rtx);
+ else
+ {
+ rtx cc = gen_rtx_REG (mode, CC_REGNUM);
+
+ emit_insn (gen_rtx_SET (VOIDmode, cc, gen_rtx_COMPARE (mode, op0, op1)));
+ ret = gen_rtx_fmt_ee (code, VOIDmode, cc, const0_rtx);
+ }
+ s390_compare_emitted = NULL_RTX;
+ return ret;
}
/* Emit a jump instruction to TARGET. If COND is NULL_RTX, emit an
@@ -4334,6 +4349,7 @@ print_operand_address (FILE *file, rtx a
'C': print opcode suffix for branch condition.
'D': print opcode suffix for inverse branch condition.
'J': print tls_load/tls_gdcall/tls_ldcall suffix
+ 'G': print the size of the operand in bytes.
'O': print only the displacement of a memory reference.
'R': print only the base register of a memory reference.
'S': print S-type memory reference (base+displacement).
@@ -4380,6 +4396,10 @@ print_operand (FILE *file, rtx x, int co
abort ();
return;
+ case 'G':
+ fprintf (file, "%u", GET_MODE_SIZE (GET_MODE (x)));
+ return;
+
case 'O':
{
struct s390_address ad;
gcc4-stack-protector.patch:
Makefile.in | 10 +-
c-cppbuiltin.c | 6 +
cfgexpand.c | 217 +++++++++++++++++++++++++++++++++++++++++++++++-
common.opt | 12 ++
config.in | 6 +
config/i386/i386.c | 25 +++++
config/i386/i386.h | 1
config/i386/i386.md | 184 ++++++++++++++++++++++++++++++----------
config/i386/linux.h | 5 +
config/i386/linux64.h | 6 +
config/rs6000/darwin.h | 14 +--
config/rs6000/linux.h | 5 +
config/rs6000/linux64.h | 6 +
config/rs6000/rs6000.c | 162 +++++++++++++++++++++++++++++++----
config/rs6000/rs6000.h | 93 +++++++++-----------
config/rs6000/rs6000.md | 82 ++++++++++++++++++
config/rs6000/sysv4.h | 5 -
config/s390/s390.c | 24 +++--
config/s390/s390.h | 10 +-
config/sparc/linux.h | 5 +
config/sparc/linux64.h | 6 +
config/sparc/sparc.c | 10 +-
config/sparc/sparc.h | 1
config/sparc/sparc.md | 93 ++++++++++++++++++++
configure | 48 ++++++++++
configure.ac | 39 ++++++++
doc/md.texi | 34 ++++++-
doc/tm.texi | 26 +++++
function.c | 104 +++++++++++++++++++++++
function.h | 4
gcc.c | 12 ++
params.def | 5 +
regrename.c | 6 +
target-def.h | 5 +
target.h | 11 ++
targhooks.c | 91 ++++++++++++++++++++
targhooks.h | 4
toplev.c | 10 ++
tree.h | 1
39 files changed, 1232 insertions(+), 156 deletions(-)
--- NEW FILE gcc4-stack-protector.patch ---
2005-07-07 Jakub Jelinek <jakub at redhat.com>
* config/sparc/sparc.md (stack_protect_testsi): Put clobbers after
all sets in the pattern.
* config/rs6000/rs6000.md (stack_protect_testsi,
stack_protect_testdi): Likewise.
2005-07-06 Kaz Kojima <kkojima at gcc.gnu.org>
* function.c (expand_function_end): Revert part of 2005-06-27
patch. Do sjlj_emit_function_exit_after after return_label.
2005-07-06 Jakub Jelinek <jakub at redhat.com>
* config/rs6000/rs6000.h (RS6000_VARARGS_AREA, RS6000_VARARGS_SIZE):
Remove.
(STARTING_FRAME_OFFSET): Don't add RS6000_VARARGS_AREA.
(machine_function): Move typedef to...
* config/rs6000/rs6000.c (machine_function): ... here. Add
varargs_save_offset field.
(rs6000_stack_t): Remove varargs_size field.
(setup_incoming_varargs): Allocate varargs save area using
assign_stack_local, try to make it as small as possible.
Save offset from virtual_stack_vars_rtx to the save area
in cfun->machine->varargs_save_offset. Use UNITS_PER_FP_WORD
instead of magic 8 when fp word byte size is used.
(rs6000_va_start): Use cfun->machine->varargs_save_offset
instead of -RS6000_VARARGS_SIZE.
(rs6000_stack_info, debug_stack_info,
rs6000_initial_elimination_offset): Remove all traces of
varargs_size.
* config/rs6000/sysv4.h (RS6000_VARARGS_AREA): Remove.
* config/rs6000/darwin.h (STARTING_FRAME_OFFSET): Don't add
RS6000_VARARGS_AREA.
2005-07-06 Jakub Jelinek <jakub at redhat.com>
* config/sparc/sparc.h (sparc_compare_emitted): New extern.
* config/sparc/sparc.c (sparc_compare_emitted): New variable.
(gen_compare_reg): If sparc_compare_emitted is set, clear it
and return its previous value.
(emit_v9_brxx_insn): Assert sparc_compare_emitted is NULL.
* config/sparc/sparc.md (UNSPEC_SP_SET, UNSPEC_SP_TEST): New
constants.
(stack_protect_set, stack_protect_test): New expanders.
(stack_protect_setsi, stack_protect_setdi, stack_protect_testsi,
stack_protect_testdi): New insns.
* config/sparc/linux.h (TARGET_THREAD_SSP_OFFSET): Define.
* config/sparc/linux64.h (TARGET_THREAD_SSP_OFFSET): Define.
2005-07-02 Jakub Jelinek <jakub at redhat.com>
* gcc.c (LINK_SSP_SPEC): Define.
(link_ssp_spec): New variable.
(LINK_COMMAND_SPEC): Add %(link_ssp).
(static_specs): Add link_ssp_spec.
* configure.ac (TARGET_LIBC_PROVIDES_SSP): New test.
* configure: Rebuilt.
* config.in: Rebuilt.
* config/rs6000/linux.h (TARGET_THREAD_SSP_OFFSET): Define.
* config/rs6000/linux64.h (TARGET_THREAD_SSP_OFFSET): Likewise.
* config/i386/linux.h (TARGET_THREAD_SSP_OFFSET): Likewise.
* config/i386/linux64.h (TARGET_THREAD_SSP_OFFSET): Likewise.
* config/rs6000/rs6000.md (stack_protect_set, stack_protect_test):
If TARGET_THREAD_SSP_OFFSET is defined, use -0x7010(13) resp.
-0x7008(2) instead of reading __stack_chk_guard variable.
* config/i386/i386.md (UNSPEC_SP_SET, UNSPEC_SP_TEST): Change
number.
(UNSPEC_SP_TLS_SET, UNSPEC_SP_TLS_TEST): New constants.
(stack_protect_set, stack_protect_test): Use *_tls* patterns
if TARGET_THREAD_SSP_OFFSET is defined.
(stack_tls_protect_set_si, stack_tls_protect_set_di,
stack_tls_protect_test_si, stack_tls_protect_test_di): New insns.
Revert:
2005-06-27 Richard Henderson <rth at redhat.com>
* libgcc-std.ver (GCC_4.1.0): New.
* libgcc.h (__stack_chk_guard): Declare.
(__stack_chk_fail, __stack_chk_fail_local): Declare.
* libgcc2.c (L_stack_chk, L_stack_chk_local): New.
* mklibgcc.in (lib2funcs): Add them.
2005-07-01 Jakub Jelinek <jakub at redhat.com>
PR target/22262
* config/i386/i386.md (stack_protect_test_si,
stack_protect_test_di): Add earlyclobber for scratch 3.
* config/rs6000/rs6000.md (stack_protect_testsi,
stack_protect_testdi): Add earlyclobber for scratch 3,
remove earlyclobber from scratch 4.
2005-06-30 Andrew Pinski <pinskia at physics.uc.edu>
* config/rs6000/darwin.h (STARTING_FRAME_OFFSET):
Set to 0 for FRAME_GROWS_DOWNWARD.
(REGISTER_NAMES): Add sfp.
2005-06-30 Andrew Pinski <pinskia at physics.uc.edu>
* config/rs6000/darwin.h (FRAME_POINTER_REGNUM): Rename to ...
(HARD_FRAME_POINTER_REGNUM): this.
2005-06-30 Jakub Jelinek <jakub at redhat.com>
* function.c (gen_stack_protect_test): Add third argument.
2005-06-30 Jakub Jelinek <jakub at redhat.com>
* function.c (stack_protect_epilogue): Pass label to
stack_protect_test, assume it emitted also the conditional
branch.
* doc/md.texi (stack_protect_test): Adjust documentation.
* config/i386/i386.md (stack_protect_test): Add third argument,
emit beq with operands[2].
* config/rs6000/rs6000.h (FRAME_GROWS_DOWNWARD): Define to
flag_stack_protect != 0.
* config/rs6000/rs6000.md (UNSPEC_SP_SET, UNSPEC_SP_TEST): New
constants.
(stack_protect_set, stack_protect_test): New expanders.
(stack_protect_setsi, stack_protect_setdi, stack_protect_testsi,
stack_protect_testdi): New insns.
* config/rs6000/rs6000.c (rs6000_stack_protect_fail): New function.
(TARGET_STACK_PROTECT_FAIL): Define.
(rs6000_generate_compare): Handle UNSPEC_SP_TEST.
* config/rs6000/rs6000.h (FIRST_PSEUDO_REGISTER): Increment.
(DWARF_FRAME_REGISTERS, DWARF_REG_TO_UNWIND_COLUMN): Adjust, so
that addition of sfp doesn't change these.
(FIXED_REGISTERS, CALL_USED_REGISTERS, CALL_REALLY_USED_REGISTERS,
REG_ALLOC_ORDER): Add sfp.
(INT_REGNO_P): Include FRAME_POINTER_REGNUM.
(FRAME_POINTER_REGNUM): Define to 113.
(HARD_FRAME_POINTER_REGNUM): Define to 31.
(REG_CLASS_CONTENTS, REGNO_REG_CLASS): Add sfp.
(STARTING_FRAME_OFFSET): Set to 0 for FRAME_GROWS_DOWNWARD.
(ELIMINABLE_REGS): Never eliminate to
FRAME_POINTER_REGNUM, but HARD_FRAME_POINTER_REGNUM
instead. Add eliminations from FRAME_POINTER_REGNUM.
(REGNO_OK_FOR_INDEX_P, REGNO_OK_FOR_BASE_P, INT_REG_OK_FOR_INDEX_P):
Include FRAME_POINTER_REGNUM.
(REGISTER_NAMES): Add sfp.
* config/rs6000/rs6000.c (rs6000_reg_names): Add sfp.
(alt_reg_names): Likewise.
(rs6000_stack_info): Handle FRAME_GROWS_DOWNWARD.
(rs6000_emit_prologue): Use HARD_FRAME_POINTER_REGNUM
instead of FRAME_POINTER_REGNUM.
(rs6000_initial_elimination_offset): Never eliminate to
FRAME_POINTER_REGNUM, but HARD_FRAME_POINTER_REGNUM
instead. Add elimination offsets from FRAME_POINTER_REGNUM.
* config/rs6000/sysv4.h (RS6000_VARARGS_AREA): Only return non-zero
if DEFAULT_ABI == ABI_V4.
2005-06-29 Andreas Krebbel <krebbel1 at de.ibm.com>
* config/s390/s390.c (s390_decompose_address): Accept invalid
displacements for addresses containing frame_pointer_rtx or
virtual_stack_vars_rtx.
(s390_frame_info): Replaced use of STARTING_FRAME_OFFSET.
(s390_initial_elimination_offset): New offset when eliminating the
soft frame pointer.
* config/s390/s390.h (FRAME_GROWS_DOWNWARD): Defined as 1.
(STARTING_FRAME_OFFSET, STACK_DYNAMIC_OFFSET): Definitions changed.
2005-06-27 Jakub Jelinek <jakub at redhat.com>
* regrename.c (copy_value): Fix comment.
* toplev.c (process_options): Use if (FRAME_GROWS_DOWNWARD)
instead of preprocessor conditionals.
* targhooks.c (default_hidden_stack_protect_fail): Fall back to
default_external_stack_protect_fail if visibility is not supported
or not flag_pic.
* config/i386/i386.c (ix86_stack_protect_fail): New function.
(TARGET_STACK_PROTECT_FAIL): Define.
* config/i386/i386.md (stack_protect_si): Change CLOBBER into
SET to zero.
(stack_protect_di): Likewise. Use %k2 instead of %2 to avoid
invalid instruction xorl %rax, %rax.
2005-06-27 Richard Henderson <rth at redhat.com>
* c-cppbuiltin.c (c_cpp_builtins): Add __SSP_ALL__ and __SSP__.
* cfgexpand.c: Include params.h.
(has_protected_decls, has_short_buffer): New.
(expand_stack_vars): Take a predicate to determine what to expand.
(defer_stack_allocation): True when flag_stack_protect on.
(SPCT_HAS_LARGE_CHAR_ARRAY, SPCT_HAS_SMALL_CHAR_ARRAY): New.
(SPCT_HAS_ARRAY, SPCT_HAS_AGGREGATE): New.
(stack_protect_classify_type, stack_protect_decl_phase): New.
(stack_protect_decl_phase_1, stack_protect_decl_phase_2): New.
(add_stack_protection_conflicts, create_stack_guard): New.
(expand_used_vars): Add stack protection logic.
(tree_expand_cfg): Likewise.
* common.opt (Wstack-protector): New.
(fstack-protector, fstack-protector-all): New.
* function.c: Include predict.h.
[...2132 lines suppressed...]
@@ -1225,6 +1225,12 @@ copy_value (rtx dest, rtx src, struct va
if (frame_pointer_needed && dr == HARD_FRAME_POINTER_REGNUM)
return;
+ /* Do not propagate copies to fixed or global registers, patterns
+ can be relying to see particular fixed register or users can
+ expect the chosen global register in asm. */
+ if (fixed_regs[dr] || global_regs[dr])
+ return;
+
/* If SRC and DEST overlap, don't record anything. */
dn = hard_regno_nregs[dr][GET_MODE (dest)];
sn = hard_regno_nregs[sr][GET_MODE (dest)];
--- gcc/target-def.h 25 Jun 2005 02:01:09 -0000 1.126
+++ gcc/target-def.h 27 Jun 2005 07:41:03 -0000 1.127
@@ -379,6 +379,9 @@ Foundation, 59 Temple Place - Suite 330,
#define TARGET_STDARG_OPTIMIZE_HOOK 0
+#define TARGET_STACK_PROTECT_GUARD default_stack_protect_guard
+#define TARGET_STACK_PROTECT_FAIL default_external_stack_protect_fail
+
#define TARGET_PROMOTE_FUNCTION_ARGS hook_bool_tree_false
#define TARGET_PROMOTE_FUNCTION_RETURN hook_bool_tree_false
#define TARGET_PROMOTE_PROTOTYPES hook_bool_tree_false
@@ -530,6 +533,8 @@ Foundation, 59 Temple Place - Suite 330,
TARGET_DWARF_CALLING_CONVENTION, \
TARGET_DWARF_HANDLE_FRAME_UNSPEC, \
TARGET_STDARG_OPTIMIZE_HOOK, \
+ TARGET_STACK_PROTECT_GUARD, \
+ TARGET_STACK_PROTECT_FAIL, \
TARGET_CALLS, \
TARGET_CXX, \
TARGET_HAVE_NAMED_SECTIONS, \
--- gcc/target.h 25 Jun 2005 02:01:09 -0000 1.138
+++ gcc/target.h 27 Jun 2005 07:41:04 -0000 1.139
@@ -526,7 +526,16 @@ struct gcc_target
from VA_ARG_EXPR. LHS is left hand side of MODIFY_EXPR, RHS
is right hand side. Returns true if the statements doesn't need
to be checked for va_list references. */
- bool (*stdarg_optimize_hook) (struct stdarg_info *ai, tree lhs, tree rhs);
+ bool (* stdarg_optimize_hook) (struct stdarg_info *ai, tree lhs, tree rhs);
+
+ /* This target hook allows the operating system to override the DECL
+ that represents the external variable that contains the stack
+ protection guard variable. The type of this DECL is ptr_type_node. */
+ tree (* stack_protect_guard) (void);
+
+ /* This target hook allows the operating system to override the CALL_EXPR
+ that is invoked when a check vs the guard variable fails. */
+ tree (* stack_protect_fail) (void);
/* Returns NULL if target supports the insn within a doloop block,
otherwise it returns an error message. */
--- gcc/targhooks.c 25 Jun 2005 02:01:10 -0000 2.42
+++ gcc/targhooks.c 27 Jun 2005 08:03:19 -0000 2.44
@@ -61,6 +61,7 @@ Software Foundation, 51 Franklin Street,
#include "target.h"
#include "tm_p.h"
#include "target-def.h"
+#include "ggc.h"
void
@@ -321,3 +322,93 @@ hook_invalid_arg_for_unprototyped_fn (
{
return NULL;
}
+
+/* Initialize the stack protection decls. */
+
+/* Stack protection related decls living in libgcc. */
+static GTY(()) tree stack_chk_guard_decl;
+
+tree
+default_stack_protect_guard (void)
+{
+ tree t = stack_chk_guard_decl;
+
+ if (t == NULL)
+ {
+ t = build_decl (VAR_DECL, get_identifier ("__stack_chk_guard"),
+ ptr_type_node);
+ TREE_STATIC (t) = 1;
+ TREE_PUBLIC (t) = 1;
+ DECL_EXTERNAL (t) = 1;
+ TREE_USED (t) = 1;
+ TREE_THIS_VOLATILE (t) = 1;
+ DECL_ARTIFICIAL (t) = 1;
+ DECL_IGNORED_P (t) = 1;
+
+ stack_chk_guard_decl = t;
+ }
+
+ return t;
+}
+
+static GTY(()) tree stack_chk_fail_decl;
+
+tree
+default_external_stack_protect_fail (void)
+{
+ tree t = stack_chk_fail_decl;
+
+ if (t == NULL_TREE)
+ {
+ t = build_function_type_list (void_type_node, NULL_TREE);
+ t = build_decl (FUNCTION_DECL, get_identifier ("__stack_chk_fail"), t);
+ TREE_STATIC (t) = 1;
+ TREE_PUBLIC (t) = 1;
+ DECL_EXTERNAL (t) = 1;
+ TREE_USED (t) = 1;
+ TREE_THIS_VOLATILE (t) = 1;
+ TREE_NOTHROW (t) = 1;
+ DECL_ARTIFICIAL (t) = 1;
+ DECL_IGNORED_P (t) = 1;
+
+ stack_chk_fail_decl = t;
+ }
+
+ return build_function_call_expr (t, NULL_TREE);
+}
+
+tree
+default_hidden_stack_protect_fail (void)
+{
+#ifndef HAVE_GAS_HIDDEN
+ return default_external_stack_protect_fail ();
+#else
+ tree t = stack_chk_fail_decl;
+
+ if (!flag_pic)
+ return default_external_stack_protect_fail ();
+
+ if (t == NULL_TREE)
+ {
+ t = build_function_type_list (void_type_node, NULL_TREE);
+ t = build_decl (FUNCTION_DECL,
+ get_identifier ("__stack_chk_fail_local"), t);
+ TREE_STATIC (t) = 1;
+ TREE_PUBLIC (t) = 1;
+ DECL_EXTERNAL (t) = 1;
+ TREE_USED (t) = 1;
+ TREE_THIS_VOLATILE (t) = 1;
+ TREE_NOTHROW (t) = 1;
+ DECL_ARTIFICIAL (t) = 1;
+ DECL_IGNORED_P (t) = 1;
+ DECL_VISIBILITY_SPECIFIED (t) = 1;
+ DECL_VISIBILITY (t) = VISIBILITY_HIDDEN;
+
+ stack_chk_fail_decl = t;
+ }
+
+ return build_function_call_expr (t, NULL_TREE);
+#endif
+}
+
+#include "gt-targhooks.h"
--- gcc/targhooks.h 25 Jun 2005 02:01:10 -0000 2.30
+++ gcc/targhooks.h 27 Jun 2005 07:40:48 -0000 2.31
@@ -34,6 +34,10 @@ extern enum machine_mode default_eh_retu
extern unsigned HOST_WIDE_INT default_shift_truncation_mask
(enum machine_mode);
+extern tree default_stack_protect_guard (void);
+extern tree default_external_stack_protect_fail (void);
+extern tree default_hidden_stack_protect_fail (void);
+
extern tree default_cxx_guard_type (void);
extern tree default_cxx_get_cookie_size (tree);
--- gcc/toplev.c 25 Jun 2005 02:01:10 -0000 1.961
+++ gcc/toplev.c 27 Jun 2005 08:05:27 -0000 1.963
@@ -1747,6 +1747,16 @@ process_options (void)
/* With -fcx-limited-range, we do cheap and quick complex arithmetic. */
if (flag_cx_limited_range)
flag_complex_method = 0;
+
+ /* Targets must be able to place spill slots at lower addresses. If the
+ target already uses a soft frame pointer, the transition is trivial. */
+ if (!FRAME_GROWS_DOWNWARD && flag_stack_protect)
+ {
+ warning ("-fstack-protector not supported for this target");
+ flag_stack_protect = 0;
+ }
+ if (!flag_stack_protect)
+ warn_stack_protect = 0;
}
/* Initialize the compiler back end. */
--- gcc/tree.h 25 Jun 2005 02:01:56 -0000 1.739
+++ gcc/tree.h 27 Jun 2005 07:40:45 -0000 1.740
@@ -3659,6 +3659,7 @@ extern int simple_cst_list_equal (tree,
extern void dump_tree_statistics (void);
extern void expand_function_end (void);
extern void expand_function_start (tree);
+extern void stack_protect_prologue (void);
extern void recompute_tree_invarant_for_addr_expr (tree);
extern bool is_global_var (tree t);
extern bool needs_to_live_in_memory (tree);
Index: .cvsignore
===================================================================
RCS file: /cvs/dist/rpms/gcc/devel/.cvsignore,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -r1.97 -r1.98
--- .cvsignore 22 Jun 2005 23:26:59 -0000 1.97
+++ .cvsignore 8 Jul 2005 21:09:20 -0000 1.98
@@ -1 +1 @@
-gcc-4.0.0-20050622.tar.bz2
+gcc-4.0.1-20050708.tar.bz2
Index: gcc4.spec
===================================================================
RCS file: /cvs/dist/rpms/gcc/devel/gcc4.spec,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- gcc4.spec 28 Jun 2005 08:56:21 -0000 1.51
+++ gcc4.spec 8 Jul 2005 21:09:22 -0000 1.52
@@ -1,6 +1,6 @@
-%define DATE 20050622
-%define gcc_version 4.0.0
-%define gcc_release 13
+%define DATE 20050708
+%define gcc_version 4.0.1
+%define gcc_release 1
%define _unpackaged_files_terminate_build 0
%define multilib_64_archs sparc64 ppc64 s390x x86_64
%ifarch %{ix86} alpha ia64 x86_64 s390 sparc sparc64
@@ -36,7 +36,8 @@
BuildRequires: binutils >= 2.15.91.0.2-4
BuildRequires: zlib-devel, gettext, dejagnu, bison, flex, texinfo
# Make sure pthread.h doesn't contain __thread tokens
-BuildRequires: glibc-devel >= 2.2.90-12
+# Make sure glibc supports stack protector
+BuildRequires: glibc-devel >= 2.3.90-2
%if %{build_ada}
# Ada requires Ada to build
BuildRequires: gcc-gnat >= 3.1, libgnat >= 3.1
@@ -75,30 +76,31 @@
Patch3: gcc4-ia64-libunwind.patch
Patch4: gcc4-gnuc-rh-release.patch
Patch5: gcc4-java-nomulti.patch
-Patch6: gcc4-c++-pr19317.patch
-Patch7: gcc4-pr20249.patch
-Patch8: gcc4-g++-struct-layout.patch
-Patch9: gcc4-pr16104-test.patch
-Patch10: gcc4-pr20490.patch
-Patch11: gcc4-libstdc++-mt-alloc.patch
-Patch12: gcc4-struct-layout.patch
-Patch13: gcc4-ppc32-hwint32.patch
-Patch14: gcc4-hard-regno-nregs.patch
-Patch15: gcc4-var-tracking-fix.patch
-Patch16: gcc4-pr19005-test.patch
-Patch17: gcc4-pr17965.patch
-Patch18: gcc4-ada-target-bit.patch
-Patch19: gcc4-slow-pthread-self.patch
-Patch20: gcc4-fortran-altreturn.patch
-Patch21: gcc4-tree-chrec.patch
-Patch22: gcc4-bitfield-ref-vec.patch
-Patch23: gcc4-pr21897.patch
-Patch24: gcc4-fortran-forall.patch
-Patch25: gcc4-fortran-forall-logical1.patch
-Patch26: gcc4-libltdl-multilib.patch
-Patch27: gcc4-pr22028.patch
-Patch28: gcc4-libstdc++-v3-versioning.patch
-Patch29: gcc4-rh133180.patch
+Patch6: gcc4-g++-struct-layout.patch
+Patch7: gcc4-pr16104-test.patch
+Patch8: gcc4-libstdc++-mt-alloc.patch
+Patch9: gcc4-struct-layout.patch
+Patch10: gcc4-ppc32-hwint32.patch
+Patch11: gcc4-var-tracking-fix.patch
+Patch12: gcc4-pr17965.patch
+Patch13: gcc4-fortran-altreturn.patch
+Patch14: gcc4-tree-chrec.patch
+Patch15: gcc4-fortran-forall.patch
+Patch16: gcc4-fortran-forall-logical1.patch
+Patch17: gcc4-libltdl-multilib.patch
+Patch18: gcc4-pr22028.patch
+Patch19: gcc4-fortran-legacy.patch
+Patch20: gcc4-fortran-logical-integer.patch
+Patch21: gcc4-fortran-hollerith.patch
+Patch22: gcc4-fortran-rh161634.patch
+Patch23: gcc4-fortran-rh161669.patch
+Patch24: gcc4-fortran-rh161679.patch
+Patch25: gcc4-fortran-rh161680.patch
+Patch26: gcc4-i386-masm=intel.patch
+Patch27: gcc4-stack-protector.patch
+Patch28: gcc4-ia64-stack-protector.patch
+Patch29: gcc4-s390-stack-protector.patch
+Patch30: gcc4-libstdc++-pr22309.patch
%define _gnu %{nil}
%ifarch sparc
@@ -413,32 +415,33 @@
%patch3 -p0 -b .ia64-libunwind~
%patch4 -p0 -b .gnuc-rh-release~
%patch5 -p0 -b .java-nomulti~
-%patch6 -p0 -b .c++-pr19317~
-%patch7 -p0 -b .pr20249~
-%patch8 -p0 -b .g++-struct-layout~
-%patch9 -p0 -b .pr16104-test~
-%patch10 -p0 -b .pr20490~
-%patch11 -p0 -b .libstdc++-mt-alloc~
-%patch12 -p0 -b .struct-layout~
-#%patch13 -p0 -b .ppc32-hwint32~
-%patch14 -p0 -b .hard-regno-nregs~
-%patch15 -p0 -b .var-tracking-fix~
-%patch16 -p0 -b .pr19005-test~
-%patch17 -p0 -b .pr17965~
-%patch18 -p0 -b .ada-target-bit~
-%patch19 -p0 -b .slow-pthread-self~
-%patch20 -p0 -b .fortran-altreturn~
-%patch21 -p0 -b .tree-chrec~
-%patch22 -p0 -b .bitfield-ref-vec~
-%patch23 -p0 -b .pr21897~
-%patch24 -p0 -b .fortran-forall~
-%patch25 -p0 -b .fortran-forall-logical1~
-%patch26 -p0 -b .libltdl-multilib~
-%patch27 -p0 -b .pr22028~
-%patch28 -p0 -b .libstdc++-v3-versioning~
-%patch29 -p0 -b .rh133180~
+%patch6 -p0 -b .g++-struct-layout~
+%patch7 -p0 -b .pr16104-test~
+%patch8 -p0 -b .libstdc++-mt-alloc~
+%patch9 -p0 -b .struct-layout~
+#%patch10 -p0 -b .ppc32-hwint32~
+%patch11 -p0 -b .var-tracking-fix~
+%patch12 -p0 -b .pr17965~
+%patch13 -p0 -b .fortran-altreturn~
+%patch14 -p0 -b .tree-chrec~
+%patch15 -p0 -b .fortran-forall~
+%patch16 -p0 -b .fortran-forall-logical1~
+%patch17 -p0 -b .libltdl-multilib~
+%patch18 -p0 -b .pr22028~
+%patch19 -p0 -b .fortran-legacy~
+%patch20 -p0 -b .fortran-logical-integer~
+%patch21 -p0 -b .fortran-hollerith~
+%patch22 -p0 -b .fortran-rh161634~
+%patch23 -p0 -b .fortran-rh161669~
+%patch24 -p0 -b .fortran-rh161679~
+%patch25 -p0 -b .fortran-rh161680~
+%patch26 -p0 -b .i386-masm=intel~
+%patch27 -p0 -b .stack-protector~
+%patch28 -p0 -b .ia64-stack-protector~
+%patch29 -p0 -b .s390-stack-protector~
+%patch30 -p0 -b .libstdc++-pr22309~
-perl -pi -e 's/4\.0\.0/4.0.0/' gcc/version.c
+perl -pi -e 's/4\.0\.2/4.0.1/' gcc/version.c
perl -pi -e 's/"%{gcc_version}"/"%{gcc_version} \(release\)"/' gcc/version.c
perl -pi -e 's/\((prerelease|experimental|release|Red Hat[^)]*)\)/\(Red Hat %{version}-%{gcc_release}\)/' gcc/version.c
@@ -546,14 +549,14 @@
# run the tests.
make %{?_smp_mflags} -k check || :
-make -C %{gcc_target_platform}/libstdc++-v3/testsuite -k check-abi-verbose || :
+cd gcc
+mv testsuite{,.normal}
+make %{?_smp_mflags} -k check RUNTESTFLAGS=--target_board=unix/-fstack-protector || :
+mv testsuite{,.ssp}
+mv testsuite{.normal,}
echo ====================TESTING=========================
( ../contrib/test_summary || : ) 2>&1 | sed -n '/^cat.*EOF/,/^EOF/{/^cat.*EOF/d;/^EOF/d;/^LAST_UPDATED:/d;p;}'
-make -C %{gcc_target_platform}/libstdc++-v3/testsuite -k check-abi || :
echo ====================TESTING END=====================
-#cd %{gcc_target_platform}/libstdc++-v3
-#./mkcheck 0
-#cd ../..
# Make protoize
make -C gcc CC="./xgcc -B ./ -O2" proto
@@ -1452,7 +1455,25 @@
%endif
%changelog
+* Fri Jul 8 2005 Jakub Jelinek <jakub at redhat.com> 4.0.1-1
+- update from CVS
+ - GCC 4.0.1 release
+ - PRs tree-optimization/22000, tree-optimization/22171, middle-end/21985,
+ target/22260, c/21911, c/22308, target/22083, middle-end/17961
+- -fstack-protector{,-all} support (Richard Henderson)
- add sparc and sparc64 to build_ada arches (#161865)
+- fix compound literal handling (Joseph S. Myers, #160018, c/22013, c/22098)
+- fix -march=i386 -masm=intel -fpic (#162585)
+- make sure libstdc++ mt allocator calls pthread_key_delete before
+ libstdc++ dlclose (#161061, PR libstdc++/22309)
+- accept fortran ENTRY without () even in FUNCTIONs (#161634)
+- fix fortran handling of ENTRY return var names as rvalues (161669)
+- fix fortran ICE on invalid preprocessor line (#161679)
+- fix fortran handling of long preprocessor lines (#161680)
+- add -std=legacy gfortran option (Roger Sayle)
+- support logical to boolean (and vice versa) conversions as legacy
+ fortran extension (Roger Sayle)
+- fortran Hollerith constant and character array fixes (Feng Wang, #161430)
* Thu Jun 23 2005 Jakub Jelinek <jakub at redhat.com> 4.0.0-13
- update from CVS
Index: sources
===================================================================
RCS file: /cvs/dist/rpms/gcc/devel/sources,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -r1.99 -r1.100
--- sources 22 Jun 2005 23:26:59 -0000 1.99
+++ sources 8 Jul 2005 21:09:22 -0000 1.100
@@ -1 +1 @@
-d841f5bdbbc780db0b013cde162b9983 gcc-4.0.0-20050622.tar.bz2
+4e680f96bc432057ab00cc46f750950c gcc-4.0.1-20050708.tar.bz2
--- gcc4-ada-target-bit.patch DELETED ---
--- gcc4-bitfield-ref-vec.patch DELETED ---
--- gcc4-c++-pr19317.patch DELETED ---
--- gcc4-hard-regno-nregs.patch DELETED ---
--- gcc4-libstdc++-v3-versioning.patch DELETED ---
--- gcc4-pr19005-test.patch DELETED ---
--- gcc4-pr20249.patch DELETED ---
--- gcc4-pr20490.patch DELETED ---
--- gcc4-pr21897.patch DELETED ---
--- gcc4-rh133180.patch DELETED ---
--- gcc4-slow-pthread-self.patch DELETED ---
More information about the fedora-cvs-commits
mailing list