Example #1
0
static try check_case_expr(g95_expr *g, g95_expr *selector) { 
 
  if (g == NULL) return SUCCESS;  
  
  if (g->type != EXPR_CONSTANT) {
    g95_error("Expression in CASE statement at %L must be a constant",          
	      &g->where);         
    return FAILURE;     
  }  
  
  if (g->ts.type != selector->ts.type) {   
    g95_error("Expression in CASE statement at %L must be of type %s",     
	      &g->where, g95_basic_typename(selector->ts.type)); 
    return FAILURE;
  }

  if (g->ts.kind != selector->ts.kind) {          
    g95_error("Expression in CASE statement at %L must be kind %d",     
	      &g->where, selector->ts.kind);       
    return FAILURE;        
  }   
   
  if (g->rank != 0) {         
    g95_error("Expression in CASE statement at %L must be scalar",          
	      &g->where);      
    return FAILURE;   
  }      
      
  return SUCCESS;    
}    
Example #2
0
static try check_case_expr(g95_expr *e, g95_expr *selector) {
int k, flag;

    if (e == NULL)
	return SUCCESS;

    if (e->type != EXPR_CONSTANT) {
	g95_error("Expression in CASE statement at %L must be a constant",
		  &e->where);
	return FAILURE;
    }

    if (e->ts.type != selector->ts.type) {
	g95_error("Expression in CASE statement at %L must be of type %s",
		  &e->where, g95_basic_typename(selector->ts.type));
	return FAILURE;
    }

    if (selector->ts.type != BT_INTEGER && selector->ts.type != BT_LOGICAL &&
	selector->ts.type != BT_CHARACTER) {
	
	g95_error("Selector in SELECT CASE statement cannot be type %s",
		  g95_typename(&selector->ts));
	return FAILURE;
    }

    if (e->ts.kind != selector->ts.kind && e->ts.type == BT_CHARACTER) {
	g95_error("Expression in CASE statement at %L must be kind %d",
		  &e->where, selector->ts.kind);
	return FAILURE;
    }

    if (e->rank != 0) {
	g95_error("Expression in CASE statement at %L must be scalar",
		  &e->where);
	return FAILURE;
    }

    if (e->ts.type == BT_INTEGER) {
	k = e->ts.kind;
	e->ts.kind = selector->ts.kind;

	flag = g95_range_check(e);
	e->ts.kind = k;

	if (flag) {
	    g95_error("Integer overflow in CASE statement at %L", &e->where);
	    return FAILURE;
	}
    }

    return SUCCESS;
}
Example #3
0
void g95_show_typespec(g95_typespec *typ) {     
     
  g95_status("(%s ", g95_basic_typename(typ->type));     
     
  switch(typ->type) {          
  case BT_DERIVED:   
    g95_status("%s", typ->derived->name); 
    break;    
    
  case BT_CHARACTER:         
    g95_show_expr(typ->cl->length);       
    break;   
   
  default:         
    g95_status("%d", typ->kind);      
    break;
  }        
        
  g95_status(")");          
}