/* assert_not_equal(a,b) becomes: * * if ((a) == (b)) then * write(_message,*) "-a- is equal to -b-" * funit_passed_ = .false. * return * end if */ static int generate_assert_not_equal(struct Code *macro) { struct Code *a = macro->u.m.args, *b; if (check_assert_args("assert_not_equal", macro, a, 2) != 2) return -1; b = a->next; fputs("! assert_not_equal()\n", fout); fputs(" if ((", fout); PRINT_CODE(a); fputs(") == (", fout); PRINT_CODE(b); fputs(")) then\n", fout); fputs(" write(funit_message_,*) \"'",fout); print_macro_arg(a); fputs("' (\", ", fout); PRINT_CODE(a); fputs(", &\n\") is equal to '", fout); print_macro_arg(b); fputs("'\"\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if", fout); return 0; }
// o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o+o void BRTKernelDef::print(std::ostream& out, int) const { char name[1024]; if (Project::gDebug) { out << "/* BRTKernelDef:" ; location.printLocation(out) ; out << " */" << std::endl; } assert(FunctionName()); assert(FunctionName()->entry); assert(FunctionName()->entry->scope); /* If the symbol for the generated assembly code already ** exists, don't generate the assembly. This allows the user ** to hand generate the code. */ #define PRINT_CODE(a,b) \ sprintf (name, "__%s_%s", FunctionName()->name.c_str(), #b); \ if (!FunctionName()->entry->scope->Lookup(name)) { \ if (globals.target & TARGET_##a) { \ BRTKernelCode *var; \ var = decl->isReduce() ? new BRT##a##ReduceCode(*this) : \ new BRT##a##KernelCode(*this); \ out << *var << std::endl; \ delete var; \ } else { \ out << "static const char *__" \ << *FunctionName() << "_" << #b << "= NULL;\n"; \ } \ } PRINT_CODE(PS20, ps20); PRINT_CODE(FP30, fp30); PRINT_CODE(ARB, arb); PRINT_CODE(CPU, cpu); #undef PRINT_CODE /* * XXX I have no idea why this is here instead of in * BRTCPUKernel::print(). It's CPU only and needs to be suppressed when * the CPU target is suppressed. --Jeremy. * The scatter functions need to be there whether or not the CPU target is repressed * For the fallback requirement --Daniel */ if (decl->isReduce()) { BRTCPUReduceCode crc(*this); BRTScatterDef sd(*crc.fDef); sd.print(out,0); // this is needed for CPU fallback for scatter whether or not CPU is enabled } printStub(out); }
/* assert_equal_with(a,b[,tol]) becomes: * * if (abs((a) - (b)) > TOLERANCE) then * write(_message,*) "-a- is not within", TOLERANCE, "of -b-" * funit_passed_ = .false. * return * end if */ static int generate_assert_equal_with(struct Code *macro) { struct Code *a = macro->u.m.args, *b; double this_tolerance; int num_args; num_args = check_assert_args2("assert_equal_with", macro, a, 2, 3); if (num_args < 2) { return -1; } b = a->next; if (num_args == 2) { if (tolerance <= 0.0) { fprintf(stderr, "near %s:%li: missing a tolerance argument or " "a set-level default tolerance\n", test_set_file_name, macro->lineno); return -1; } this_tolerance = tolerance; } else if (num_args == 3) { this_tolerance = strtod(b->next->u.c.str, NULL); if (this_tolerance <= 0.0) { fprintf(stderr, "near %s:%li: in assert_array_equal(): parsed " "a tolerance <= 0.0; you need to fix that\n", test_set_file_name, macro->lineno); return -1; } } fprintf(fout, "! assert_equal_with(%s)\n", (num_args == 3) ? "tol" : ""); fputs(" if (abs((", fout); PRINT_CODE(a); fputs(") - (", fout); PRINT_CODE(b); fprintf(fout, ")) > %g) then\n", this_tolerance); fputs(" write(funit_message_,*) \"'",fout); print_macro_arg(a); fputs("' (\", ", fout); PRINT_CODE(a); fprintf(fout, ", &\n\") is not within %g of '", this_tolerance); print_macro_arg(b); fputs("'\"\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if", fout); return 0; }
static void print_array_size_check(struct Code *a, struct Code *b) { fputs(" if (size(", fout); PRINT_CODE(a); fputs(") /= size(", fout); PRINT_CODE(b); fputs(")) then\n", fout); fputs(" write(funit_message_,*) \"'",fout); print_macro_arg(a); fputs("' and '", fout); print_macro_arg(b); fputs("' &\n &are not the same length:\", size(", fout); PRINT_CODE(a); fputs("), \"vs.\", size(", fout); PRINT_CODE(b); fputs(")\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if\n", fout); }
/* assert_array_equal(a,b) becomes: * * if (size(a) /= size(b)) then * write(funit_message_,*) "-a- is length", size(a), & * "which is not the same as -b- which is length", size(b) * funit_passed_ = .false. * return * end if * do funit_i_ = 1,size(a) * if (a(funit_i_) /= b(funit_i_)) then * write(funit_message_,*) "-a-(", funit_i_, ") is not equal to -b-(", & * funit_i_, "): ", a(funit_i_), "vs", b(funit_i_) * funit_passed_ = .false. * return * end if * end do */ static int generate_assert_array_equal(struct Code *macro) { struct Code *a = macro->u.m.args, *b; if (check_assert_args("assert_array_equal", macro, a, 2) != 2) return -1; b = a->next; fputs("! assert_array_equal()\n", fout); print_array_size_check(a, b); // do loop fputs(" do funit_i_ = 1,size(", fout); PRINT_CODE(a); fputs(")\n", fout); fputs(" if (", fout); PRINT_CODE(a); fputs("(funit_i_) /= ", fout); PRINT_CODE(b); fputs("(funit_i_)) then\n", fout); fputs(" write(funit_message_,*) \"", fout); print_macro_arg(a); fputs("(\", funit_i_, &\n \") is not equal to ", fout); print_macro_arg(b); fputs("(\", funit_i_, &\n \"): \", ", fout); PRINT_CODE(a); fputs("(funit_i_), \"vs\", ", fout); PRINT_CODE(b); fputs("(funit_i_)\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if\n", fout); fputs(" end do", fout); return 0; }
/* flunk(msg) becomes: * * write(funit_message_,*) -msg- * funit_passed_ = .false. * return */ static int generate_flunk(struct Code *macro) { struct Code *arg = macro->u.m.args; if (check_assert_args("flunk", macro, arg, 1) != 1) return -1; fputs("! flunk()\n", fout); fputs(" write(funit_message_,*) ", fout); PRINT_CODE(arg); fputs("\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); return 0; }
static int generate_code(struct Code *code) { switch (code->type) { case FORTRAN_CODE: PRINT_CODE(code); break; case MACRO_CODE: if (generate_assert(code)) return -1; break; default: // arg code fprintf(stderr, "near %s:%li: bad code type %i in generate_code\n", test_set_file_name, code->lineno, (int)code->type); abort(); break; } if (code->next) return generate_code(code->next); return 0; }
/* assert_false(expr) becomes: * * if (-expr-) then * write(_message,*) "-expr-", "is true" * funit_passed_ = .false. * return * end if */ static int generate_assert_false(struct Code *macro) { struct Code *arg = macro->u.m.args; if (check_assert_args("assert_false", macro, arg, 1) != 1) return -1; fputs("! assert_false()\n", fout); fputs(" if (", fout); PRINT_CODE(arg); fputs(") then\n", fout); fputs(" write(funit_message_,*) \"'", fout); print_macro_arg(arg); fputs("' is true\"\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if", fout); return 0; }
/* assert_array_equal_with(a,b[,tol]) becomes: * * if (size(a) /= size(b)) then * write(_message,*) "-a- is length", size(a), & * "which is not the same as -b- which is length", size(b) * funit_passed_ = .false. * return * end if * do funit_i_ = 1,size(a) * if (abs(a(funit_i_) - b(funit_i_)) > TOLERANCE) then * write(_message,*) "-a-(", funit_i_, ") is not within", TOLERANCE, & * "of -b-(", funit_i_, "): ", a(funit_i_), "vs", b(funit_i_) * funit_passed_ = .false. * return * end if * end do */ static int generate_assert_array_equal_with(struct Code *macro) { struct Code *a = macro->u.m.args, *b; float this_tolerance; int num_args; num_args = check_assert_args2("assert_array_equal", macro, a, 2, 3); if (num_args < 2) { return -1; } b = a->next; if (num_args == 2) { if (tolerance <= 0.0) { fprintf(stderr, "near %s:%li: in assert_array_equal(): missing " "a tolerance argument or a set-level default tolerance\n", test_set_file_name, macro->lineno); return -1; } this_tolerance = tolerance; } else if (num_args == 3) { this_tolerance = strtod(b->next->u.c.str, NULL); if (this_tolerance <= 0.0) { fprintf(stderr, "near %s:%li: in assert_array_equal(): parsed " "a tolerance <= 0.0; you need to fix that\n", test_set_file_name, macro->lineno); return -1; } } fprintf(fout, "! assert_array_equal_with(%s)\n", (num_args == 3) ? "tol" : ""); // length check print_array_size_check(a, b); // do loop fputs(" do funit_i_ = 1,size(", fout); PRINT_CODE(a); fputs(")\n", fout); fputs(" if (abs(", fout); PRINT_CODE(a); fputs("(funit_i_) - ", fout); PRINT_CODE(b); fprintf(fout, "(funit_i_)) > %g) then\n", this_tolerance); fputs(" write(funit_message_,*) \"", fout); print_macro_arg(a); fprintf(fout, "(\", funit_i_, &\n \") is not within %g of ", this_tolerance); print_macro_arg(b); fputs("(\", funit_i_, &\n \"): \", ", fout); PRINT_CODE(a); fputs("(funit_i_), \"vs\", ", fout); PRINT_CODE(b); fputs("(funit_i_)\n", fout); fputs(" funit_passed_ = .false.\n", fout); fputs(" return\n", fout); fputs(" end if\n", fout); fputs(" end do", fout); return 0; }