| 1383 | // |
| 1384 | |
| 1385 | static act* par_based() |
| 1386 | { |
| 1387 | bool notSegment = false; // a COBOL specific patch |
| 1388 | |
| 1389 | MSC_match(KW_ON); |
| 1390 | act* action = MSC_action(0, ACT_basedon); |
| 1391 | bas* based_on = (bas*) MSC_alloc(BAS_LEN); |
| 1392 | action->act_object = (ref*) based_on; |
| 1393 | |
| 1394 | if ((gpreGlob.sw_language != lang_fortran) || gpreGlob.isc_databases) |
| 1395 | { |
| 1396 | TEXT s[ERROR_LENGTH]; |
| 1397 | gpre_rel* relation = EXP_relation(); |
| 1398 | if (!MSC_match(KW_DOT)) |
| 1399 | CPR_s_error("dot in qualified field reference"); |
| 1400 | SQL_resolve_identifier("<fieldname>", NULL, NAME_SIZE + 1); |
| 1401 | if (gpreGlob.token_global.tok_length >= NAME_SIZE) |
| 1402 | PAR_error("Field length too long"); |
| 1403 | |
| 1404 | gpre_fld* field = MET_field(relation, gpreGlob.token_global.tok_string); |
| 1405 | if (!field) |
| 1406 | { |
| 1407 | fb_utils::snprintf(s, sizeof(s), "undefined field %s", gpreGlob.token_global.tok_string); |
| 1408 | PAR_error(s); |
| 1409 | } |
| 1410 | if (SQL_DIALECT_V5 == gpreGlob.sw_sql_dialect) |
| 1411 | { |
| 1412 | switch (field->fld_dtype) |
| 1413 | { |
| 1414 | case dtype_sql_date: |
| 1415 | case dtype_sql_time: |
| 1416 | case dtype_int64: |
| 1417 | PAR_error("BASED ON impermissible datatype for a dialect-1 program"); |
| 1418 | } |
| 1419 | } |
| 1420 | PAR_get_token(); |
| 1421 | char tmpChar[2]; // a COBOL specific patch |
| 1422 | if (gpreGlob.sw_language == lang_cobol && gpreGlob.token_global.tok_keyword == KW_DOT) { |
| 1423 | strcpy(tmpChar, gpreGlob.token_global.tok_string); |
| 1424 | } |
| 1425 | if (MSC_match(KW_DOT)) |
| 1426 | { |
| 1427 | if (!MSC_match(KW_SEGMENT)) |
| 1428 | { |
| 1429 | if (gpreGlob.sw_language != lang_cobol) |
| 1430 | PAR_error("only .SEGMENT allowed after qualified field name"); |
| 1431 | else |
| 1432 | { |
| 1433 | strcpy(based_on->bas_terminator, tmpChar); |
| 1434 | notSegment = true; |
| 1435 | } |
| 1436 | } |
| 1437 | else if (!(field->fld_flags & FLD_blob)) |
| 1438 | { |
| 1439 | fb_utils::snprintf(s, sizeof(s), "field %s is not a blob", field->fld_symbol->sym_string); |
| 1440 | PAR_error(s); |
| 1441 | } |
| 1442 | // this flag is to solve KW_DOT problem in COBOL. Should be false for all other lang |
no test coverage detected