/* expr.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995-1998 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002
+ Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
#include "str.h"
#include "target.h"
#include "where.h"
+#include "real.h"
/* Externals defined here. */
<= FFEEXPR_operatorprecedenceLOWARITH_)
&& (e->u.operator.prec <= FFEEXPR_operatorprecedenceLOWARITH_))
{
+ /* xgettext:no-c-format */
ffebad_start_msg ("Two arithmetic operators in a row at %0 and %1 -- use parentheses",
ffe_is_pedantic ()
? FFEBAD_severityPEDANTIC
&& (e->u.operator.prec
< ffeexpr_stack_->exprstack->previous->u.operator.prec))
{
+ /* xgettext:no-c-format */
ffebad_start_msg ("Operator at %0 has lower precedence than that at %1 -- use parentheses", FFEBAD_severityWARNING);
ffebad_here (0,
ffelex_token_where_line (ffeexpr_stack_->exprstack->previous->token),
if ((lbt == FFEINFO_basictypeLOGICAL)
&& (rbt == FFEINFO_basictypeLOGICAL))
{
+ /* xgettext:no-c-format */
if (ffebad_start_msg ("Use .EQV./.NEQV. instead of .EQ./.NE. at %0 for LOGICAL operands at %1 and %2",
FFEBAD_severityFATAL))
{
}
if (rkt == FFEINFO_kindtypeINTEGER4)
{
+ /* xgettext:no-c-format */
ffebad_start_msg ("Unsupported operand for ** at %1 -- converting to default INTEGER",
FFEBAD_severityWARNING);
ffebad_here (0, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
/* else Leave it alone. */
}
+ if (lbt == FFEINFO_basictypeLOGICAL)
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ }
+
+ if (rbt == FFEINFO_basictypeLOGICAL)
+ {
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ }
+
return reduced;
}
case FFEEXPR_contextINDEX_:
case FFEEXPR_contextSFUNCDEFINDEX_:
- case FFEEXPR_contextRETURN:
if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
break;
switch ((expr == NULL) ? FFEINFO_basictypeNONE
break;
}
/* Fall through. */
- case FFEINFO_basictypeINTEGER:
case FFEINFO_basictypeHOLLERITH:
case FFEINFO_basictypeTYPELESS:
error = FALSE;
FFEEXPR_contextLET);
break;
+ case FFEINFO_basictypeINTEGER:
+ /* Specifically, allow INTEGER(KIND=2), aka INTEGER*8, through
+ unmolested. Leave it to downstream to handle kinds. */
+ break;
+
default:
error = TRUE;
break;
break; /* expr==NULL ok for substring; element case
caught by callback. */
+ case FFEEXPR_contextRETURN:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeNONE:
+ error = FALSE;
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
case FFEEXPR_contextDO:
if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
break;
error = (expr == NULL)
|| ((ffeinfo_rank (info) != 0) ?
ffe_is_pedantic () /* F77 C5. */
- : (ffeinfo_kindtype (info) != ffecom_label_kind ()))
+ : (bool) (ffeinfo_kindtype (info) != ffecom_label_kind ()))
|| (ffebld_op (expr) != FFEBLD_opSYMTER);
break;
FFETARGET_charactersizeNONE));
ffesymbol_signal_unreported (s);
- if (((ffesymbol_basictype (sp) != FFEINFO_basictypeINTEGER)
+ if ((ffesymbol_basictype (sp) != FFEINFO_basictypeINTEGER)
&& (ffesymbol_basictype (sp) != FFEINFO_basictypeANY))
- || ((ffesymbol_kindtype (sp) != FFEINFO_kindtypeINTEGERDEFAULT)
- && (ffesymbol_kindtype (sp) != FFEINFO_kindtypeANY)))
ffesymbol_error (s, t);
return s;
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsTYPE)))
na = sa | FFESYMBOL_attrsADJUSTS;
else
case FFEEXPR_contextDIMLIST:
s = ffeexpr_sym_rhs_dimlist_ (s, t);
+ bad = FALSE;
break;
case FFEEXPR_contextCHARACTERSIZE:
ffeexpr_stack_->immediate = FALSE;
break;
}
- if (ffebld_op (expr) == FFEBLD_opCONTER)
+ if (ffebld_op (expr) == FFEBLD_opCONTER
+ && ffebld_kindtype (expr) == FFEINFO_kindtypeINTEGERDEFAULT)
{
val = ffebld_constant_integerdefault (ffebld_conter (expr));
ffetargetIntegerDefault last_val;
ffetargetCharacterSize size;
ffetargetCharacterSize strop_size_max;
+ bool first_known;
string = ffeexpr_stack_->exprstack;
strop = string->u.operand;
info = ffebld_info (strop);
- if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+ if (first == NULL
+ || (ffebld_op (first) == FFEBLD_opCONTER
+ && ffebld_kindtype (first) == FFEINFO_kindtypeINTEGERDEFAULT))
{ /* The starting point is known. */
first_val = (first == NULL) ? 1
: ffebld_constant_integerdefault (ffebld_conter (first));
+ first_known = TRUE;
}
else
{ /* Assume start of the entity. */
first_val = 1;
+ first_known = FALSE;
}
- if ((last != NULL) && (ffebld_op (last) == FFEBLD_opCONTER))
+ if (last != NULL
+ && (ffebld_op (last) == FFEBLD_opCONTER
+ && ffebld_kindtype (last) == FFEINFO_kindtypeINTEGERDEFAULT))
{ /* The ending point is known. */
last_val = ffebld_constant_integerdefault (ffebld_conter (last));
- if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+ if (first_known)
{ /* The beginning point is a constant. */
if (first_val <= last_val)
size = last_val - first_val + 1;
OSDN Git Service
