/* expr.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995-1997 Free Software Foundation, Inc.
- Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+ 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 files. */
#include "proj.h"
-#include <ctype.h>
#include "expr.h"
#include "bad.h"
#include "bld.h"
#include "src.h"
#include "st.h"
#include "symbol.h"
+#include "str.h"
#include "target.h"
#include "where.h"
+#include "real.h"
/* Externals defined here. */
typedef enum
{
- FFEEXPR_dotdotNONE_,
- FFEEXPR_dotdotTRUE_,
- FFEEXPR_dotdotFALSE_,
- FFEEXPR_dotdotNOT_,
- FFEEXPR_dotdotAND_,
- FFEEXPR_dotdotOR_,
- FFEEXPR_dotdotXOR_,
- FFEEXPR_dotdotEQV_,
- FFEEXPR_dotdotNEQV_,
- FFEEXPR_dotdotLT_,
- FFEEXPR_dotdotLE_,
- FFEEXPR_dotdotEQ_,
- FFEEXPR_dotdotNE_,
- FFEEXPR_dotdotGT_,
- FFEEXPR_dotdotGE_,
- FFEEXPR_dotdot
- } ffeexprDotdot_;
-
-typedef enum
- {
FFEEXPR_exprtypeUNKNOWN_,
FFEEXPR_exprtypeOPERAND_,
FFEEXPR_exprtypeUNARY_,
static ffeexprStack_ ffeexpr_stack_; /* Expression stack for semantic. */
static ffelexToken ffeexpr_tokens_[10]; /* Scratchpad tokens for syntactic. */
-static ffeexprDotdot_ ffeexpr_current_dotdot_; /* Current .FOO. keyword. */
+static ffestrOther ffeexpr_current_dotdot_; /* Current .FOO. keyword. */
static long ffeexpr_hollerith_count_; /* ffeexpr_token_number_ and caller. */
static int ffeexpr_level_; /* Level of DATA implied-DO construct. */
static bool ffeexpr_is_substr_ok_; /* If OPEN_PAREN as binary "op" ok. */
static void ffeexpr_update_impdo_ (ffebld expr, ffebld dovar);
static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar);
static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s);
-static ffeexprDotdot_ ffeexpr_dotdot_ (ffelexToken t);
static ffeexprExpr_ ffeexpr_expr_new_ (void);
static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
-static bool ffeexpr_isdigits_ (char *p);
+static bool ffeexpr_isdigits_ (const char *p);
static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t);
static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t);
static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_integer1_val
(ffebld_cu_val_integer1 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_integer2_val
(ffebld_cu_val_integer2 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_integer3_val
(ffebld_cu_val_integer3 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_integer4_val
(ffebld_cu_val_integer4 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_logical1_val
(ffebld_cu_val_logical1 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_logical2_val
(ffebld_cu_val_logical2 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_logical3_val
(ffebld_cu_val_logical3 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_logical4_val
(ffebld_cu_val_logical4 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_real1_val
(ffebld_cu_val_real1 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_real2_val
(ffebld_cu_val_real2 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_real3_val
(ffebld_cu_val_real3 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_real4_val
(ffebld_cu_val_real4 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_complex1_val
(ffebld_cu_val_complex1 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_complex2_val
(ffebld_cu_val_complex2 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_complex3_val
(ffebld_cu_val_complex3 (u)), expr);
break;
}
+ /* If conversion operation is not implemented, return original expr. */
+ if (error == FFEBAD_NOCANDO)
+ return expr;
+
expr = ffebld_new_conter_with_orig
(ffebld_constant_new_complex4_val
(ffebld_cu_val_complex4 (u)), expr);
}
}
-/* ffeexpr_dotdot_ -- Look up name in list of .FOO. possibilities
-
- ffeexprDotdot_ d;
- ffelexToken t;
- d = ffeexpr_dotdot_(t);
-
- Returns the identifier for the name, or the NONE identifier. */
-
-static ffeexprDotdot_
-ffeexpr_dotdot_ (ffelexToken t)
-{
- char *p;
-
- switch (ffelex_token_length (t))
- {
- case 2:
- switch (*(p = ffelex_token_text (t)))
- {
- case FFESRC_CASE_MATCH_INIT ('E', 'e', match_2e, no_match_2):
- if (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
- return FFEEXPR_dotdotEQ_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('G', 'g', match_2g, no_match_2):
- if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
- return FFEEXPR_dotdotGE_;
- if (ffesrc_char_match_noninit (*p, 'T', 't'))
- return FFEEXPR_dotdotGT_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('L', 'l', match_2l, no_match_2):
- if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
- return FFEEXPR_dotdotLE_;
- if (ffesrc_char_match_noninit (*p, 'T', 't'))
- return FFEEXPR_dotdotLT_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('N', 'n', match_2n, no_match_2):
- if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
- return FFEEXPR_dotdotNE_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('O', 'o', match_2o, no_match_2):
- if (ffesrc_char_match_noninit (*++p, 'R', 'r'))
- return FFEEXPR_dotdotOR_;
- return FFEEXPR_dotdotNONE_;
-
- default:
- no_match_2: /* :::::::::::::::::::: */
- return FFEEXPR_dotdotNONE_;
- }
-
- case 3:
- switch (*(p = ffelex_token_text (t)))
- {
- case FFESRC_CASE_MATCH_INIT ('A', 'a', match_3a, no_match_3):
- if ((ffesrc_char_match_noninit (*++p, 'N', 'n'))
- && (ffesrc_char_match_noninit (*++p, 'D', 'd')))
- return FFEEXPR_dotdotAND_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('E', 'e', match_3e, no_match_3):
- if ((ffesrc_char_match_noninit (*++p, 'Q', 'q'))
- && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
- return FFEEXPR_dotdotEQV_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('N', 'n', match_3n, no_match_3):
- if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
- && (ffesrc_char_match_noninit (*++p, 'T', 't')))
- return FFEEXPR_dotdotNOT_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('X', 'x', match_3x, no_match_3):
- if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
- && (ffesrc_char_match_noninit (*++p, 'R', 'r')))
- return FFEEXPR_dotdotXOR_;
- return FFEEXPR_dotdotNONE_;
-
- default:
- no_match_3: /* :::::::::::::::::::: */
- return FFEEXPR_dotdotNONE_;
- }
-
- case 4:
- switch (*(p = ffelex_token_text (t)))
- {
- case FFESRC_CASE_MATCH_INIT ('N', 'n', match_4n, no_match_4):
- if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
- && (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
- && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
- return FFEEXPR_dotdotNEQV_;
- return FFEEXPR_dotdotNONE_;
-
- case FFESRC_CASE_MATCH_INIT ('T', 't', match_4t, no_match_4):
- if ((ffesrc_char_match_noninit (*++p, 'R', 'r'))
- && (ffesrc_char_match_noninit (*++p, 'U', 'u'))
- && (ffesrc_char_match_noninit (*++p, 'E', 'e')))
- return FFEEXPR_dotdotTRUE_;
- return FFEEXPR_dotdotNONE_;
-
- default:
- no_match_4: /* :::::::::::::::::::: */
- return FFEEXPR_dotdotNONE_;
- }
-
- case 5:
- if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "FALSE",
- "false", "False")
- == 0)
- return FFEEXPR_dotdotFALSE_;
- return FFEEXPR_dotdotNONE_;
-
- default:
- return FFEEXPR_dotdotNONE_;
- }
-}
-
/* ffeexpr_percent_ -- Look up name in list of %FOO possibilities
ffeexprPercent_ p;
static ffeexprPercent_
ffeexpr_percent_ (ffelexToken t)
{
- char *p;
+ const char *p;
switch (ffelex_token_length (t))
{
else
{ /* The normal stuff. */
if (nbt == lbt)
- if (nbt == rbt)
- nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
- else
- nkt = lkt;
+ {
+ if (nbt == rbt)
+ nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
+ else
+ nkt = lkt;
+ }
else if (nbt == rbt)
nkt = rkt;
else
as = FFEGLOBAL_argsummaryALTRTN;
break;
+#if 0
+ /* No, %LOC(foo) is just like any INTEGER(KIND=7)
+ expression, so don't treat it specially. */
case FFEBLD_opPERCENT_LOC:
as = FFEGLOBAL_argsummaryPTR;
break;
+#endif
case FFEBLD_opPERCENT_VAL:
as = FFEGLOBAL_argsummaryVAL;
break;
case FFEBLD_opFUNCREF:
+#if 0
+ /* No, LOC(foo) is just like any INTEGER(KIND=7)
+ expression, so don't treat it specially. */
if ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER)
&& (ffesymbol_specific (ffebld_symter (ffebld_left (item)))
== FFEINTRIN_specLOC))
as = FFEGLOBAL_argsummaryPTR;
break;
}
+#endif
/* Fall through. */
default:
if (ffebld_op (item) == FFEBLD_opSYMTER)
/* Check whether rest of string is all decimal digits. */
static bool
-ffeexpr_isdigits_ (char *p)
+ffeexpr_isdigits_ (const char *p)
{
for (; *p != '\0'; ++p)
- if (!isdigit (*p))
+ if (! ISDIGIT (*p))
return FALSE;
return TRUE;
}
<= 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),
&& (left_operand->previous->type != FFEEXPR_exprtypeOPERAND_)
&& (left_operand->previous->u.operator.op
== FFEEXPR_operatorSUBTRACT_))
- if (left_operand->previous->type == FFEEXPR_exprtypeUNARY_)
- ffetarget_integer_bad_magical_precedence (left_operand->token,
- left_operand->previous->token,
- operator->token);
- else
- ffetarget_integer_bad_magical_precedence_binary
- (left_operand->token,
- left_operand->previous->token,
- operator->token);
+ {
+ if (left_operand->previous->type == FFEEXPR_exprtypeUNARY_)
+ ffetarget_integer_bad_magical_precedence (left_operand->token,
+ left_operand->previous->token,
+ operator->token);
+ else
+ ffetarget_integer_bad_magical_precedence_binary
+ (left_operand->token,
+ left_operand->previous->token,
+ operator->token);
+ }
else
ffetarget_integer_bad_magical (left_operand->token);
}
if ((ffebld_op (expr) == FFEBLD_opCONTER)
&& (ffebld_conter_orig (expr) == NULL)
&& ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
- if (submag)
- ffetarget_integer_bad_magical_binary (operand->token,
- operator->token);
- else
- ffetarget_integer_bad_magical (operand->token);
+ {
+ if (submag)
+ ffetarget_integer_bad_magical_binary (operand->token,
+ operator->token);
+ else
+ ffetarget_integer_bad_magical (operand->token);
+ }
ffeexpr_stack_->exprstack = left_operand->previous; /* Pops binary-op
operands off stack. */
ffeexpr_expr_kill_ (left_operand);
if ((lkd != FFEINFO_kindANY)
&& ffebad_start (FFEBAD_CONCAT_ARG_KIND))
{
- char *what;
+ const char *what;
if (lrk != 0)
what = "an array";
{
if (ffebad_start (FFEBAD_CONCAT_ARG_KIND))
{
- char *what;
+ const char *what;
if (rrk != 0)
what = "an array";
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 FFELEX_typeNAME:
case FFELEX_typeNAMES:
- ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ ffeexpr_current_dotdot_ = ffestr_other (t);
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotNONE_:
+ case FFESTR_otherNone:
return (ffelexHandler) ffeexpr_nil_rhs_ (t);
- case FFEEXPR_dotdotTRUE_:
- case FFEEXPR_dotdotFALSE_:
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherTRUE:
+ case FFESTR_otherFALSE:
+ case FFESTR_otherNOT:
return (ffelexHandler) ffeexpr_nil_end_period_;
default:
{
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherNOT:
if (ffelex_token_type (t) != FFELEX_typePERIOD)
return (ffelexHandler) ffeexpr_nil_rhs_ (t);
return (ffelexHandler) ffeexpr_nil_rhs_;
- case FFEEXPR_dotdotTRUE_:
- case FFEEXPR_dotdotFALSE_:
+ case FFESTR_otherTRUE:
+ case FFESTR_otherFALSE:
if (ffelex_token_type (t) != FFELEX_typePERIOD)
return (ffelexHandler) ffeexpr_nil_binary_ (t);
return (ffelexHandler) ffeexpr_nil_binary_;
ffeexpr_nil_real_ (ffelexToken t)
{
char d;
- char *p;
+ const char *p;
if (((ffelex_token_type (t) != FFELEX_typeNAME)
&& (ffelex_token_type (t) != FFELEX_typeNAMES))
ffeexpr_nil_number_ (ffelexToken t)
{
char d;
- char *p;
+ const char *p;
if (ffeexpr_hollerith_count_ > 0)
ffelex_set_expecting_hollerith (0, '\0',
{
ffelexHandler nexthandler;
char d;
- char *p;
+ const char *p;
switch (ffelex_token_type (t))
{
ffeexpr_nil_number_real_ (ffelexToken t)
{
char d;
- char *p;
+ const char *p;
if (((ffelex_token_type (t) != FFELEX_typeNAME)
&& (ffelex_token_type (t) != FFELEX_typeNAMES))
{
case FFELEX_typeNAME:
case FFELEX_typeNAMES:
- ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ ffeexpr_current_dotdot_ = ffestr_other (t);
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotTRUE_:
- case FFEEXPR_dotdotFALSE_:
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherTRUE:
+ case FFESTR_otherFALSE:
+ case FFESTR_otherNOT:
return (ffelexHandler) ffeexpr_nil_binary_sw_per_;
default:
default:
break;
}
- error = ((expr == NULL) && ffe_is_pedantic ())
- || ((expr != NULL) && (ffeinfo_rank (info) != 0));
+ error = (expr != NULL) && (ffeinfo_rank (info) != 0);
break;
case FFEEXPR_contextACTUALARG_:
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;
switch (ffeinfo_basictype (info))
{
case FFEINFO_basictypeLOGICAL:
- error = error && !ffe_is_ugly_logint ();
- if (!ffeexpr_stack_->is_rhs)
- break; /* Don't convert lhs variable. */
+ if (! ffe_is_ugly_logint ())
+ error = TRUE;
+ if (! ffeexpr_stack_->is_rhs)
+ break;
expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
- ffeinfo_kindtype (ffebld_info (expr)), 0,
+ ffeinfo_kindtype (info), 0,
FFETARGET_charactersizeNONE,
FFEEXPR_contextLET);
break;
switch (ffeinfo_basictype (info))
{
case FFEINFO_basictypeLOGICAL:
- error = error
- && (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT);
- if (!ffeexpr_stack_->is_rhs)
- break; /* Don't convert lhs variable. */
+ if (! ffeexpr_stack_->is_rhs)
+ break;
expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
- FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ ffeinfo_kindtype (info), 0,
+ FFETARGET_charactersizeNONE,
FFEEXPR_contextLET);
- break;
-
+ /* Fall through. */
case FFEINFO_basictypeINTEGER:
- error = error &&
- (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+ if (ffeexpr_stack_->is_rhs
+ && (ffeinfo_kindtype (ffebld_info (expr))
+ != FFEINFO_kindtypeINTEGERDEFAULT))
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
break;
case FFEINFO_basictypeHOLLERITH:
: ffeinfo_basictype (info))
{
case FFEINFO_basictypeINTEGER:
- error = FALSE;
+ /* Maybe this should be supported someday, but, right now,
+ g77 can't generate a call to libf2c to write to an
+ integer other than the default size. */
+ error = ((! ffeexpr_stack_->is_rhs)
+ && ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
break;
default:
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;
{
case FFELEX_typeNAME:
case FFELEX_typeNAMES:
- ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ ffeexpr_current_dotdot_ = ffestr_other (t);
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotNONE_:
+ case FFESTR_otherNone:
if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
{
ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
ffelex_token_kill (ffeexpr_tokens_[0]);
return (ffelexHandler) ffeexpr_token_rhs_ (t);
- case FFEEXPR_dotdotTRUE_:
- case FFEEXPR_dotdotFALSE_:
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherTRUE:
+ case FFESTR_otherFALSE:
+ case FFESTR_otherNOT:
ffeexpr_tokens_[1] = ffelex_token_use (t);
return (ffelexHandler) ffeexpr_token_end_period_;
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherNOT:
e->type = FFEEXPR_exprtypeUNARY_;
e->u.operator.op = FFEEXPR_operatorNOT_;
e->u.operator.prec = FFEEXPR_operatorprecedenceNOT_;
return (ffelexHandler) ffeexpr_token_rhs_ (t);
return (ffelexHandler) ffeexpr_token_rhs_;
- case FFEEXPR_dotdotTRUE_:
+ case FFESTR_otherTRUE:
e->type = FFEEXPR_exprtypeOPERAND_;
e->u.operand
= ffebld_new_conter (ffebld_constant_new_logicaldefault (TRUE));
return (ffelexHandler) ffeexpr_token_binary_ (t);
return (ffelexHandler) ffeexpr_token_binary_;
- case FFEEXPR_dotdotFALSE_:
+ case FFESTR_otherFALSE:
e->type = FFEEXPR_exprtypeOPERAND_;
e->u.operand
= ffebld_new_conter (ffebld_constant_new_logicaldefault (FALSE));
ffeexpr_token_real_ (ffelexToken t)
{
char d;
- char *p;
+ const char *p;
if (((ffelex_token_type (t) != FFELEX_typeNAME)
&& (ffelex_token_type (t) != FFELEX_typeNAMES))
ffeexprExpr_ e;
ffeinfo ni;
char d;
- char *p;
+ const char *p;
if (ffeexpr_hollerith_count_ > 0)
ffelex_set_expecting_hollerith (0, '\0',
/* Nothing specific we were looking for, so make an integer and pass the
current token to the binary state. */
- e = ffeexpr_expr_new_ ();
- e->type = FFEEXPR_exprtypeOPERAND_;
- e->token = ffeexpr_tokens_[0];
- e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
- (ffeexpr_tokens_[0]));
- ffebld_set_info (e->u.operand,
- ffeinfo_new (FFEINFO_basictypeINTEGER,
- FFEINFO_kindtypeINTEGERDEFAULT, 0,
- FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
- FFETARGET_charactersizeNONE));
- ffeexpr_exprstack_push_operand_ (e);
+ ffeexpr_make_float_const_ ('I', ffeexpr_tokens_[0], NULL, NULL,
+ NULL, NULL, NULL);
return (ffelexHandler) ffeexpr_token_binary_ (t);
}
{
ffeexprExpr_ e;
ffelexHandler nexthandler;
- char *p;
+ const char *p;
char d;
switch (ffelex_token_type (t))
ffeexpr_token_number_real_ (ffelexToken t)
{
char d;
- char *p;
+ const char *p;
if (((ffelex_token_type (t) != FFELEX_typeNAME)
&& (ffelex_token_type (t) != FFELEX_typeNAMES))
{
case FFELEX_typeNAME:
case FFELEX_typeNAMES:
- ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ ffeexpr_current_dotdot_ = ffestr_other (t);
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotTRUE_:
- case FFEEXPR_dotdotFALSE_:
- case FFEEXPR_dotdotNOT_:
+ case FFESTR_otherTRUE:
+ case FFESTR_otherFALSE:
+ case FFESTR_otherNOT:
if (ffest_ffebad_start (FFEBAD_MISSING_BINARY_OPERATOR))
{
operand = ffeexpr_stack_->exprstack;
ffelex_token_kill (ffeexpr_tokens_[0]);
return (ffelexHandler) ffeexpr_token_binary_sw_per_;
- case FFEEXPR_dotdotNONE_:
- if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
- {
- ffebad_string (ffelex_token_text (t));
- ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
- ffelex_token_where_column (ffeexpr_tokens_[0]));
- ffebad_finish ();
- }
- ffeexpr_current_dotdot_ = FFEEXPR_dotdotEQ_;
- /* Fall through here, pretending we got a .EQ. operator. */
default:
ffeexpr_tokens_[1] = ffelex_token_use (t);
return (ffelexHandler) ffeexpr_token_binary_end_per_;
{
ffeexprExpr_ e;
- if (ffelex_token_type (t) != FFELEX_typePERIOD)
- {
- if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
- {
- ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
- ffelex_token_where_column (ffeexpr_tokens_[0]));
- ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
- ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
- ffebad_finish ();
- }
- }
-
- ffelex_token_kill (ffeexpr_tokens_[1]); /* Kill dot-dot token. */
-
e = ffeexpr_expr_new_ ();
e->type = FFEEXPR_exprtypeBINARY_;
e->token = ffeexpr_tokens_[0];
switch (ffeexpr_current_dotdot_)
{
- case FFEEXPR_dotdotAND_:
+ case FFESTR_otherAND:
e->u.operator.op = FFEEXPR_operatorAND_;
e->u.operator.prec = FFEEXPR_operatorprecedenceAND_;
e->u.operator.as = FFEEXPR_operatorassociativityAND_;
break;
- case FFEEXPR_dotdotOR_:
+ case FFESTR_otherOR:
e->u.operator.op = FFEEXPR_operatorOR_;
e->u.operator.prec = FFEEXPR_operatorprecedenceOR_;
e->u.operator.as = FFEEXPR_operatorassociativityOR_;
break;
- case FFEEXPR_dotdotXOR_:
+ case FFESTR_otherXOR:
e->u.operator.op = FFEEXPR_operatorXOR_;
e->u.operator.prec = FFEEXPR_operatorprecedenceXOR_;
e->u.operator.as = FFEEXPR_operatorassociativityXOR_;
break;
- case FFEEXPR_dotdotEQV_:
+ case FFESTR_otherEQV:
e->u.operator.op = FFEEXPR_operatorEQV_;
e->u.operator.prec = FFEEXPR_operatorprecedenceEQV_;
e->u.operator.as = FFEEXPR_operatorassociativityEQV_;
break;
- case FFEEXPR_dotdotNEQV_:
+ case FFESTR_otherNEQV:
e->u.operator.op = FFEEXPR_operatorNEQV_;
e->u.operator.prec = FFEEXPR_operatorprecedenceNEQV_;
e->u.operator.as = FFEEXPR_operatorassociativityNEQV_;
break;
- case FFEEXPR_dotdotLT_:
+ case FFESTR_otherLT:
e->u.operator.op = FFEEXPR_operatorLT_;
e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
e->u.operator.as = FFEEXPR_operatorassociativityLT_;
break;
- case FFEEXPR_dotdotLE_:
+ case FFESTR_otherLE:
e->u.operator.op = FFEEXPR_operatorLE_;
e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
e->u.operator.as = FFEEXPR_operatorassociativityLE_;
break;
- case FFEEXPR_dotdotEQ_:
+ case FFESTR_otherEQ:
e->u.operator.op = FFEEXPR_operatorEQ_;
e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
break;
- case FFEEXPR_dotdotNE_:
+ case FFESTR_otherNE:
e->u.operator.op = FFEEXPR_operatorNE_;
e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
e->u.operator.as = FFEEXPR_operatorassociativityNE_;
break;
- case FFEEXPR_dotdotGT_:
+ case FFESTR_otherGT:
e->u.operator.op = FFEEXPR_operatorGT_;
e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
e->u.operator.as = FFEEXPR_operatorassociativityGT_;
break;
- case FFEEXPR_dotdotGE_:
+ case FFESTR_otherGE:
e->u.operator.op = FFEEXPR_operatorGE_;
e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
e->u.operator.as = FFEEXPR_operatorassociativityGE_;
break;
default:
- assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
+ if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+ ffebad_finish ();
+ }
+ e->u.operator.op = FFEEXPR_operatorEQ_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+ e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+ break;
}
ffeexpr_exprstack_push_binary_ (e);
if (ffelex_token_type (t) != FFELEX_typePERIOD)
- return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ {
+ if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[1]); /* Kill dot-dot token. */
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ }
+
+ ffelex_token_kill (ffeexpr_tokens_[1]); /* Kill dot-dot token. */
return (ffelexHandler) ffeexpr_token_rhs_;
}
break;
#endif
+ case 'I': /* Make an integer. */
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+ (ffeexpr_tokens_[0]));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ break;
+
default:
no_match: /* :::::::::::::::::::: */
assert ("Lost the exponent letter!" == NULL);
version. */
if (!ffeimplic_establish_symbol (sp))
ffesymbol_error (sp, t);
- ffesymbol_set_info (sp,
- ffeinfo_new (ffesymbol_basictype (sp),
- ffesymbol_kindtype (sp),
- ffesymbol_rank (sp),
- kind,
- where,
- ffesymbol_size (sp)));
- ffesymbol_set_attrs (sp, na);
- ffesymbol_set_state (sp, ns);
- ffesymbol_resolve_intrin (sp);
- if (!ffesymbol_state_is_specable (ns))
- sp = ffecom_sym_learned (sp);
- ffesymbol_signal_unreported (sp); /* For debugging purposes. */
+ else
+ {
+ ffesymbol_set_info (sp,
+ ffeinfo_new (ffesymbol_basictype (sp),
+ ffesymbol_kindtype (sp),
+ ffesymbol_rank (sp),
+ kind,
+ where,
+ ffesymbol_size (sp)));
+ ffesymbol_set_attrs (sp, na);
+ ffesymbol_set_state (sp, ns);
+ ffesymbol_resolve_intrin (sp);
+ if (!ffesymbol_state_is_specable (ns))
+ sp = ffecom_sym_learned (sp);
+ ffesymbol_signal_unreported (sp); /* For debugging purposes. */
+ }
}
}
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 FFEINFO_kindENTITY:
if (ffesymbol_rank (s) == 0)
- if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
- *paren_type = FFEEXPR_parentypeSUBSTRING_;
- else
- {
- bad = TRUE;
- *paren_type = FFEEXPR_parentypeANY_;
- }
+ {
+ if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ *paren_type = FFEEXPR_parentypeSUBSTRING_;
+ else
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ }
+ }
else
*paren_type = FFEEXPR_parentypeARRAY_;
break;
case FFEEXPR_contextDIMLIST:
s = ffeexpr_sym_rhs_dimlist_ (s, t);
+ bad = FALSE;
break;
case FFEEXPR_contextCHARACTERSIZE:
case FFEINFO_kindENTITY:
if (ffesymbol_rank (s) == 0)
- if (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE)
- *paren_type = FFEEXPR_parentypeEQUIVALENCE_;
- else if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
- *paren_type = FFEEXPR_parentypeSUBSTRING_;
- else
- {
- bad = TRUE;
- *paren_type = FFEEXPR_parentypeANY_;
- }
+ {
+ if (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE)
+ *paren_type = FFEEXPR_parentypeEQUIVALENCE_;
+ else if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ *paren_type = FFEEXPR_parentypeSUBSTRING_;
+ else
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ }
+ }
else
*paren_type = FFEEXPR_parentypeARRAY_;
break;
procedure = ffeexpr_stack_->exprstack;
info = ffebld_info (procedure->u.operand);
- if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
- { /* Statement function (or subroutine, if
- there was such a thing). */
- if ((expr == NULL)
- && ((ffe_is_pedantic ()
- && (ffeexpr_stack_->expr != NULL))
- || (ffelex_token_type (t) == FFELEX_typeCOMMA)))
+ /* Is there an expression to add? If the expression is nil,
+ it might still be an argument. It is if:
+
+ - The current token is comma, or
+
+ - The -fugly-comma flag was specified *and* the procedure
+ being invoked is external.
+
+ Otherwise, if neither of the above is the case, just
+ ignore this (nil) expression. */
+
+ if ((expr != NULL)
+ || (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ || (ffe_is_ugly_comma ()
+ && (ffeinfo_where (info) == FFEINFO_whereGLOBAL)))
+ {
+ /* This expression, even if nil, is apparently intended as an argument. */
+
+ /* Internal procedure (CONTAINS, or statement function)? */
+
+ if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
{
- if (ffebad_start (FFEBAD_NULL_ARGUMENT))
+ if ((expr == NULL)
+ && ffebad_start (FFEBAD_NULL_ARGUMENT))
{
ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
- ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
ffebad_here (1, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_finish ();
}
- if (ffeexpr_stack_->next_dummy != NULL)
- { /* Don't bother if we're going to complain
- later! */
- expr = ffebld_new_conter
- (ffebld_constant_new_integerdefault_val (0));
- ffebld_set_info (expr, ffeinfo_new_any ());
- }
- }
- if (expr == NULL)
- ;
- else
- {
- if (ffeexpr_stack_->next_dummy == NULL)
- { /* Report later which was the first extra
- argument. */
- if (ffeexpr_stack_->tokens[1] == NULL)
- {
- ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
- ffeexpr_stack_->num_args = 0;
- }
- ++ffeexpr_stack_->num_args; /* Count # of extra
- arguments. */
- }
+ if (expr == NULL)
+ ;
else
{
- if (ffeinfo_rank (ffebld_info (expr)) != 0)
+ if (ffeexpr_stack_->next_dummy == NULL)
+ { /* Report later which was the first extra argument. */
+ if (ffeexpr_stack_->tokens[1] == NULL)
+ {
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+ ffeexpr_stack_->num_args = 0;
+ }
+ ++ffeexpr_stack_->num_args; /* Count # of extra arguments. */
+ }
+ else
{
- if (ffebad_start (FFEBAD_ARRAY_AS_SFARG))
+ if ((ffeinfo_rank (ffebld_info (expr)) != 0)
+ && ffebad_start (FFEBAD_ARRAY_AS_SFARG))
{
ffebad_here (0,
- ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
- ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
ffebad_here (1, ffelex_token_where_line (ft),
ffelex_token_where_column (ft));
ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent
- (ffebld_symter (ffebld_head
- (ffeexpr_stack_->next_dummy)))));
+ (ffebld_symter (ffebld_head
+ (ffeexpr_stack_->next_dummy)))));
ffebad_finish ();
}
+ else
+ {
+ expr = ffeexpr_convert_expr (expr, ft,
+ ffebld_head (ffeexpr_stack_->next_dummy),
+ ffeexpr_stack_->tokens[0],
+ FFEEXPR_contextLET);
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
+ --ffeexpr_stack_->num_args; /* Count down # of args. */
+ ffeexpr_stack_->next_dummy
+ = ffebld_trail (ffeexpr_stack_->next_dummy);
}
- else
- {
- expr = ffeexpr_convert_expr (expr, ft,
- ffebld_head (ffeexpr_stack_->next_dummy),
- ffeexpr_stack_->tokens[0],
- FFEEXPR_contextLET);
- ffebld_append_item (&ffeexpr_stack_->bottom, expr);
- }
- --ffeexpr_stack_->num_args; /* Count down # of args. */
- ffeexpr_stack_->next_dummy
- = ffebld_trail (ffeexpr_stack_->next_dummy);
}
}
+ else
+ {
+ if ((expr == NULL)
+ && ffe_is_pedantic ()
+ && ffebad_start (FFEBAD_NULL_ARGUMENT_W))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_here (1, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
}
- else if ((expr != NULL) || ffe_is_ugly_comma ()
- || (ffelex_token_type (t) == FFELEX_typeCOMMA))
- ffebld_append_item (&ffeexpr_stack_->bottom, expr);
switch (ffelex_token_type (t))
{
only if next token isn't the close-paren for REAL(me). */
if ((ffeexpr_stack_->previous != NULL)
+ && (ffeexpr_stack_->previous->exprstack != NULL)
&& (ffeexpr_stack_->previous->exprstack->type == FFEEXPR_exprtypeOPERAND_)
&& ((reduced = ffeexpr_stack_->previous->exprstack->u.operand) != NULL)
&& (ffebld_op (reduced) == FFEBLD_opSYMTER)
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
