diff options
Diffstat (limited to 'gcc/f/expr.c')
| -rw-r--r-- | gcc/f/expr.c | 98 |
1 files changed, 83 insertions, 15 deletions
diff --git a/gcc/f/expr.c b/gcc/f/expr.c index 7e7bf867875..72a6264dbf4 100644 --- a/gcc/f/expr.c +++ b/gcc/f/expr.c @@ -1,6 +1,6 @@ /* expr.c -- Implementation File (module.c template V1.0) Copyright (C) 1995-1998 Free Software Foundation, Inc. - Contributed by James Craig Burley (burley@gnu.org). + Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -268,7 +268,7 @@ static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar); static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s); 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); @@ -633,6 +633,10 @@ ffeexpr_collapse_convert (ffebld expr, 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); @@ -822,6 +826,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_integer2_val (ffebld_cu_val_integer2 (u)), expr); @@ -1011,6 +1019,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_integer3_val (ffebld_cu_val_integer3 (u)), expr); @@ -1200,6 +1212,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_integer4_val (ffebld_cu_val_integer4 (u)), expr); @@ -1317,6 +1333,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_logical1_val (ffebld_cu_val_logical1 (u)), expr); @@ -1424,6 +1444,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_logical2_val (ffebld_cu_val_logical2 (u)), expr); @@ -1531,6 +1555,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_logical3_val (ffebld_cu_val_logical3 (u)), expr); @@ -1638,6 +1666,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_logical4_val (ffebld_cu_val_logical4 (u)), expr); @@ -1796,6 +1828,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_real1_val (ffebld_cu_val_real1 (u)), expr); @@ -1944,6 +1980,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_real2_val (ffebld_cu_val_real2 (u)), expr); @@ -2092,6 +2132,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_real3_val (ffebld_cu_val_real3 (u)), expr); @@ -2240,6 +2284,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_real4_val (ffebld_cu_val_real4 (u)), expr); @@ -2398,6 +2446,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_complex1_val (ffebld_cu_val_complex1 (u)), expr); @@ -2546,6 +2598,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_complex2_val (ffebld_cu_val_complex2 (u)), expr); @@ -2694,6 +2750,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_complex3_val (ffebld_cu_val_complex3 (u)), expr); @@ -2842,6 +2902,10 @@ ffeexpr_collapse_convert (ffebld expr, 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_complex4_val (ffebld_cu_val_complex4 (u)), expr); @@ -8520,7 +8584,7 @@ ffeexpr_context_outer_ (ffeexprStack_ s) static ffeexprPercent_ ffeexpr_percent_ (ffelexToken t) { - char *p; + const char *p; switch (ffelex_token_length (t)) { @@ -9473,7 +9537,7 @@ ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t) /* 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)) @@ -10314,7 +10378,7 @@ ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, if ((lkd != FFEINFO_kindANY) && ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { - char *what; + const char *what; if (lrk != 0) what = "an array"; @@ -10330,7 +10394,7 @@ ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, { if (ffebad_start (FFEBAD_CONCAT_ARG_KIND)) { - char *what; + const char *what; if (rrk != 0) what = "an array"; @@ -11602,7 +11666,7 @@ static ffelexHandler 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)) @@ -11640,7 +11704,7 @@ static ffelexHandler ffeexpr_nil_number_ (ffelexToken t) { char d; - char *p; + const char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', @@ -11715,7 +11779,7 @@ ffeexpr_nil_number_period_ (ffelexToken t) { ffelexHandler nexthandler; char d; - char *p; + const char *p; switch (ffelex_token_type (t)) { @@ -11772,7 +11836,7 @@ static ffelexHandler 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)) @@ -12853,7 +12917,11 @@ again: /* :::::::::::::::::::: */ : 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: @@ -13584,7 +13652,7 @@ static ffelexHandler 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)) @@ -13741,7 +13809,7 @@ ffeexpr_token_number_ (ffelexToken t) ffeexprExpr_ e; ffeinfo ni; char d; - char *p; + const char *p; if (ffeexpr_hollerith_count_ > 0) ffelex_set_expecting_hollerith (0, '\0', @@ -13897,7 +13965,7 @@ ffeexpr_token_number_period_ (ffelexToken t) { ffeexprExpr_ e; ffelexHandler nexthandler; - char *p; + const char *p; char d; switch (ffelex_token_type (t)) @@ -14015,7 +14083,7 @@ static ffelexHandler 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)) |