diff --git a/integration_tests/CMakeLists.txt b/integration_tests/CMakeLists.txt index 04ec924724..35fdfe9dc0 100644 --- a/integration_tests/CMakeLists.txt +++ b/integration_tests/CMakeLists.txt @@ -554,6 +554,9 @@ RUN(NAME format_11 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) RUN(NAME format_12 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) RUN(NAME format_13 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) RUN(NAME format_14 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) +RUN(NAME format_15 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) +RUN(NAME format_16 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) +RUN(NAME format_17 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) RUN(NAME submodule_01 LABELS gfortran) RUN(NAME submodule_02 LABELS gfortran) diff --git a/integration_tests/format_15.f90 b/integration_tests/format_15.f90 new file mode 100644 index 0000000000..7da15c9347 --- /dev/null +++ b/integration_tests/format_15.f90 @@ -0,0 +1,5 @@ +program format_15 + integer ::i + 10 FORMAT (5A,I100) + write (*,10) ('*',i=1,5), 12345678 +end program format_15 \ No newline at end of file diff --git a/integration_tests/format_16.f90 b/integration_tests/format_16.f90 new file mode 100644 index 0000000000..d91e28e794 --- /dev/null +++ b/integration_tests/format_16.f90 @@ -0,0 +1,5 @@ +program format_16 + integer ::i + write(*,201) ('*',i=1,10) + 201 FORMAT( 10X, 'whatever', /, 10A ) +end program format_16 \ No newline at end of file diff --git a/integration_tests/format_17.f90 b/integration_tests/format_17.f90 new file mode 100644 index 0000000000..285b190090 --- /dev/null +++ b/integration_tests/format_17.f90 @@ -0,0 +1,5 @@ +program format_17 + integer ::i + 201 FORMAT( 3I1 ) + write(*,201) (1,i=1,3) +end program format_17 \ No newline at end of file diff --git a/src/lfortran/semantics/ast_body_visitor.cpp b/src/lfortran/semantics/ast_body_visitor.cpp index 44634bba9b..6cb197e34f 100644 --- a/src/lfortran/semantics/ast_body_visitor.cpp +++ b/src/lfortran/semantics/ast_body_visitor.cpp @@ -707,16 +707,22 @@ class BodyVisitor : public CommonVisitor { a_fmt_constant = ASRUtils::EXPR(ASR::make_StringConstant_t( al, a_fmt->base.loc, s2c(al, format_statements[label]), a_fmt_type)); } - if (a_fmt_constant) { + // Don't use stringFormat with single character argument + if (!a_fmt + && _type == AST::stmtType::Write + && a_values_vec.size() == 1 + && ASR::is_a(*ASRUtils::expr_type(a_values_vec[0]))){ + tmp = ASR::make_FileWrite_t(al, loc, m_label, a_unit, + a_iomsg, a_iostat, a_id, a_values_vec.p, + a_values_vec.size(), a_separator, a_end, overloaded_stmt); + } else if ( _type == AST::stmtType::Write ) { // If not the previous case, Wrap everything in stringFormat. ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_Character_t( al, loc, -1, 0, nullptr)); - ASR::expr_t* string_format = ASRUtils::EXPR(ASRUtils::make_StringFormat_t_util(al, a_fmt->base.loc, + ASR::expr_t* string_format = ASRUtils::EXPR(ASRUtils::make_StringFormat_t_util(al, a_fmt? a_fmt->base.loc : read_write_stmt.base.loc, a_fmt_constant, a_values_vec.p, a_values_vec.size(), ASR::string_format_kindType::FormatFortran, type, nullptr)); a_values_vec.reserve(al, 1); a_values_vec.push_back(al, string_format); - } - if( _type == AST::stmtType::Write ) { tmp = ASR::make_FileWrite_t(al, loc, m_label, a_unit, a_iomsg, a_iostat, a_id, a_values_vec.p, a_values_vec.size(), a_separator, a_end, overloaded_stmt); diff --git a/src/libasr/codegen/asr_to_cpp.cpp b/src/libasr/codegen/asr_to_cpp.cpp index 8e5587bb8f..b2de4b7e54 100644 --- a/src/libasr/codegen/asr_to_cpp.cpp +++ b/src/libasr/codegen/asr_to_cpp.cpp @@ -625,8 +625,16 @@ Kokkos::View from_std_vector(const std::vector &v) void visit_FileWrite(const ASR::FileWrite_t &x) { std::string indent(indentation_level*indentation_spaces, ' '); std::string out = indent + "std::cout "; - for (size_t i=0; ivisit_expr(*x.m_values[i]); + //HACKISH way to handle print refactoring (always using stringformat). + // TODO : Implement stringformat visitor. + ASR::StringFormat_t* str_fmt = nullptr; + size_t n_values = x.n_values; + if(x.m_values[0] && ASR::is_a(*x.m_values[0])) { + str_fmt = ASR::down_cast(x.m_values[0]); + n_values = str_fmt->n_args; + } + for (size_t i=0; ivisit_expr(*(str_fmt->m_args[i])): this->visit_expr(*x.m_values[i]); out += "<< " + src + " "; } out += "<< std::endl;\n"; diff --git a/src/libasr/codegen/asr_to_fortran.cpp b/src/libasr/codegen/asr_to_fortran.cpp index a0ff3617cc..dcd8d73891 100644 --- a/src/libasr/codegen/asr_to_fortran.cpp +++ b/src/libasr/codegen/asr_to_fortran.cpp @@ -1057,12 +1057,16 @@ class ASRToFortranVisitor : public ASR::BaseVisitor } if (x.n_values > 0 && is_a(*x.m_values[0])) { ASR::StringFormat_t *sf = down_cast(x.m_values[0]); - visit_expr(*sf->m_fmt); - if (is_a(*sf->m_fmt) - && (!startswith(src, "\"(") || !endswith(src, ")\""))) { - src = "\"(" + src.substr(1, src.size()-2) + ")\""; + if(sf->m_fmt){ + visit_expr(*sf->m_fmt); + if (is_a(*sf->m_fmt) + && (!startswith(src, "\"(") || !endswith(src, ")\""))) { + src = "\"(" + src.substr(1, src.size()-2) + ")\""; + } + r += src; + } else { + r += "*"; } - r += src; } else { r += "*"; } diff --git a/src/libasr/codegen/asr_to_llvm.cpp b/src/libasr/codegen/asr_to_llvm.cpp index 3ea7dd8d9d..34c629871a 100644 --- a/src/libasr/codegen/asr_to_llvm.cpp +++ b/src/libasr/codegen/asr_to_llvm.cpp @@ -8292,8 +8292,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor //Create ArrayPhysicalCast to get the array pointer. ASR::ttype_t* array_type = ASRUtils::TYPE(ASR::make_Array_t(al, v->base.loc,arr->m_type, arr->m_dims, arr->n_dims,ASR::array_physical_typeType::FixedSizeArray)); - ASR::expr_t* array_casted_to_pointer = ASRUtils::EXPR(ASR::make_ArrayPhysicalCast_t(al, v->base.loc, v,arr->m_physical_type, + ASR::expr_t* array_casted_to_pointer; + if(arr->m_physical_type == ASR::array_physical_typeType::PointerToDataArray){ + array_casted_to_pointer = v; //Don't cast, It's already casted. + } else { + array_casted_to_pointer = ASRUtils::EXPR(ASR::make_ArrayPhysicalCast_t(al, v->base.loc, v,arr->m_physical_type, ASR::array_physical_typeType::PointerToDataArray, array_type, nullptr)); + } // Create size argument. int array_size; diff --git a/src/libasr/pass/print_arr.cpp b/src/libasr/pass/print_arr.cpp index 4031f6d1e1..6f8ed1f7f1 100644 --- a/src/libasr/pass/print_arr.cpp +++ b/src/libasr/pass/print_arr.cpp @@ -316,64 +316,67 @@ class PrintArrVisitor : public PassUtils::PassVisitor write_body.clear(); } - void visit_FileWrite(const ASR::FileWrite_t& x) { - if (x.m_unit && ASRUtils::is_character(*ASRUtils::expr_type(x.m_unit))) { - // Skip for character write - return; - } - std::vector write_body; - ASR::stmt_t* write_stmt; - ASR::stmt_t* empty_file_write_endl = ASRUtils::STMT(ASR::make_FileWrite_t(al, x.base.base.loc, - x.m_label, x.m_unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr, nullptr)); - if(x.m_values && x.m_values[0] != nullptr && ASR::is_a(*x.m_values[0])){ - ASR::StringFormat_t* format = ASR::down_cast(x.m_values[0]); - for (size_t i=0; in_args; i++) { - if (PassUtils::is_array(format->m_args[i])) { - if (ASRUtils::is_fixed_size_array(ASRUtils::expr_type(format->m_args[i]))) { - print_fixed_sized_array(format->m_args[i], write_body, x.base.base.loc); - } else { - if (write_body.size() > 0) { - write_stmt = create_formatstmt(write_body, format, - x.base.base.loc, ASR::stmtType::FileWrite, x.m_unit, x.m_separator, - x.m_end, x.m_overloaded); - pass_result.push_back(al, write_stmt); - } - write_stmt = write_array_using_doloop(format->m_args[i], format, x.m_unit, x.base.base.loc); - pass_result.push_back(al, write_stmt); - pass_result.push_back(al, empty_file_write_endl); - } - } else { - write_body.push_back(format->m_args[i]); - } - } - if (write_body.size() > 0) { - write_stmt = create_formatstmt(write_body, format, x.base.base.loc, - ASR::stmtType::FileWrite, x.m_unit, x.m_separator, - x.m_end, x.m_overloaded); - pass_result.push_back(al, write_stmt); - } - return; - } - for (size_t i=0; i 0) { - print_args_apart_from_arrays(write_body, x); - pass_result.push_back(al, empty_file_write_endl); - } - write_stmt = write_array_using_doloop(x.m_values[i], nullptr, x.m_unit, x.base.base.loc); - pass_result.push_back(al, write_stmt); - pass_result.push_back(al, empty_file_write_endl); - } else { - write_body.push_back(x.m_values[i]); - } - } - if (write_body.size() > 0) { - print_args_apart_from_arrays(write_body, x); - } - } + // TODO :: CREATE write visitor to loop on arrays of type `structType` only, + // otherwise arrays are handled by backend. + + // void visit_FileWrite(const ASR::FileWrite_t& x) { + // if (x.m_unit && ASRUtils::is_character(*ASRUtils::expr_type(x.m_unit))) { + // // Skip for character write + // return; + // } + // std::vector write_body; + // ASR::stmt_t* write_stmt; + // ASR::stmt_t* empty_file_write_endl = ASRUtils::STMT(ASR::make_FileWrite_t(al, x.base.base.loc, + // x.m_label, x.m_unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr, nullptr)); + // if(x.m_values && x.m_values[0] != nullptr && ASR::is_a(*x.m_values[0])){ + // ASR::StringFormat_t* format = ASR::down_cast(x.m_values[0]); + // for (size_t i=0; in_args; i++) { + // if (PassUtils::is_array(format->m_args[i])) { + // if (ASRUtils::is_fixed_size_array(ASRUtils::expr_type(format->m_args[i]))) { + // print_fixed_sized_array(format->m_args[i], write_body, x.base.base.loc); + // } else { + // if (write_body.size() > 0) { + // write_stmt = create_formatstmt(write_body, format, + // x.base.base.loc, ASR::stmtType::FileWrite, x.m_unit, x.m_separator, + // x.m_end, x.m_overloaded); + // pass_result.push_back(al, write_stmt); + // } + // write_stmt = write_array_using_doloop(format->m_args[i], format, x.m_unit, x.base.base.loc); + // pass_result.push_back(al, write_stmt); + // pass_result.push_back(al, empty_file_write_endl); + // } + // } else { + // write_body.push_back(format->m_args[i]); + // } + // } + // if (write_body.size() > 0) { + // write_stmt = create_formatstmt(write_body, format, x.base.base.loc, + // ASR::stmtType::FileWrite, x.m_unit, x.m_separator, + // x.m_end, x.m_overloaded); + // pass_result.push_back(al, write_stmt); + // } + // return; + // } + // for (size_t i=0; i 0) { + // print_args_apart_from_arrays(write_body, x); + // pass_result.push_back(al, empty_file_write_endl); + // } + // write_stmt = write_array_using_doloop(x.m_values[i], nullptr, x.m_unit, x.base.base.loc); + // pass_result.push_back(al, write_stmt); + // pass_result.push_back(al, empty_file_write_endl); + // } else { + // write_body.push_back(x.m_values[i]); + // } + // } + // if (write_body.size() > 0) { + // print_args_apart_from_arrays(write_body, x); + // } + // } }; diff --git a/src/libasr/runtime/lfortran_intrinsics.c b/src/libasr/runtime/lfortran_intrinsics.c index 39a81c1a66..f2a6c5fd12 100644 --- a/src/libasr/runtime/lfortran_intrinsics.c +++ b/src/libasr/runtime/lfortran_intrinsics.c @@ -952,9 +952,9 @@ LFORTRAN_API char* _lcompilers_string_format_fortran(int count, const char* form struct array_iteration_state array_state; array_state.array_size = -1; array_state.current_arr_index = -1; + int32_t current_arg_type_int = -1; // holds int that represents type of argument. while (1) { int scale = 0; - int32_t current_arg_type_int = -1; // holds int that represents type of argument. bool is_array = false; bool array_looping = false; for (int i = item_start; i < format_values_count; i++) { diff --git a/tests/reference/asr-intrinsics_open_close_read_write-a696eca.json b/tests/reference/asr-intrinsics_open_close_read_write-a696eca.json index fc04c28b82..aa78ad77b3 100644 --- a/tests/reference/asr-intrinsics_open_close_read_write-a696eca.json +++ b/tests/reference/asr-intrinsics_open_close_read_write-a696eca.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-intrinsics_open_close_read_write-a696eca.stdout", - "stdout_hash": "e57c139379d37e9e2669c3860b9e53706b6cf4c3ff0e949d7ec49d0a", + "stdout_hash": "47aaf5efcb6e4d3287dd4a7ee1820ac5cca05be8883597c7e2f724b5", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-intrinsics_open_close_read_write-a696eca.stdout b/tests/reference/asr-intrinsics_open_close_read_write-a696eca.stdout index 8d8cc821f8..5d1c44f5fe 100644 --- a/tests/reference/asr-intrinsics_open_close_read_write-a696eca.stdout +++ b/tests/reference/asr-intrinsics_open_close_read_write-a696eca.stdout @@ -414,22 +414,28 @@ () () () - [(ArrayItem - (Var 2 p) - [(() - (Var 2 i) - ())] - (Real 4) - ColMajor + [(StringFormat () - ) - (ArrayItem - (Var 2 q) - [(() - (Var 2 i) - ())] - (Real 4) - ColMajor + [(ArrayItem + (Var 2 p) + [(() + (Var 2 i) + ())] + (Real 4) + ColMajor + () + ) + (ArrayItem + (Var 2 q) + [(() + (Var 2 i) + ())] + (Real 4) + ColMajor + () + )] + FormatFortran + (Character -1 0 ()) () )] () diff --git a/tests/reference/asr-print3-5f4fc26.json b/tests/reference/asr-print3-5f4fc26.json index e6a3711563..5309cdbf5f 100644 --- a/tests/reference/asr-print3-5f4fc26.json +++ b/tests/reference/asr-print3-5f4fc26.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-print3-5f4fc26.stdout", - "stdout_hash": "ec9ac9af5097e844c8f19f225064fa542ec859f3a5b14131a35d4a14", + "stdout_hash": "9a4448373ec29e4be8ac99c62a815333b84230c1354c23c6eb5aad58", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-print3-5f4fc26.stdout b/tests/reference/asr-print3-5f4fc26.stdout index e084c028c5..96ac591eec 100644 --- a/tests/reference/asr-print3-5f4fc26.stdout +++ b/tests/reference/asr-print3-5f4fc26.stdout @@ -80,11 +80,17 @@ () () () - [(StringConstant - "x is " - (Character 1 5 ()) - ) - (Var 2 x)] + [(StringFormat + () + [(StringConstant + "x is " + (Character 1 5 ()) + ) + (Var 2 x)] + FormatFortran + (Character -1 0 ()) + () + )] () () () diff --git a/tests/reference/llvm-print_01-63a0480.json b/tests/reference/llvm-print_01-63a0480.json index 7f8484a96e..b3a2b92208 100644 --- a/tests/reference/llvm-print_01-63a0480.json +++ b/tests/reference/llvm-print_01-63a0480.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "llvm-print_01-63a0480.stdout", - "stdout_hash": "1f0c2755fe64a9536e9652fe73f55a11f392a1a6d7751ffef890ff01", + "stdout_hash": "d8fc72b67635a05b631f8ee83733598b3c28f9ca4edefbc9b4c9432c", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/llvm-print_01-63a0480.stdout b/tests/reference/llvm-print_01-63a0480.stdout index a56db94911..06b93d191d 100644 --- a/tests/reference/llvm-print_01-63a0480.stdout +++ b/tests/reference/llvm-print_01-63a0480.stdout @@ -6,7 +6,7 @@ source_filename = "LFortran" @2 = private unnamed_addr constant [5 x i8] c"%s%s\00", align 1 @3 = private unnamed_addr constant [2 x i8] c" \00", align 1 @4 = private unnamed_addr constant [2 x i8] c"\0A\00", align 1 -@5 = private unnamed_addr constant [21 x i8] c"%d%s%d%s%d%s%d%s%d%s\00", align 1 +@5 = private unnamed_addr constant [5 x i8] c"%s%s\00", align 1 define i32 @main(i32 %0, i8** %1) { .entry: @@ -24,10 +24,14 @@ define i32 @main(i32 %0, i8** %1) { %9 = call i8* (i32, i8*, ...) @_lcompilers_string_format_fortran(i32 10, i8* null, i32 2, i64 %3, i32 2, i64 1, i32 2, i64 3, i32 2, i64 %5, i32 2, i64 %8) call void (i8*, ...) @_lfortran_printf(i8* getelementptr inbounds ([5 x i8], [5 x i8]* @2, i32 0, i32 0), i8* %9, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @1, i32 0, i32 0)) %10 = load i32, i32* %x1, align 4 - %11 = load i32, i32* %x1, align 4 + %11 = sext i32 %10 to i64 %12 = load i32, i32* %x1, align 4 - %13 = add i32 25, %12 - call void (i8*, ...) @_lfortran_printf(i8* getelementptr inbounds ([21 x i8], [21 x i8]* @5, i32 0, i32 0), i32 %10, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @3, i32 0, i32 0), i32 1, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @3, i32 0, i32 0), i32 3, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @3, i32 0, i32 0), i32 %11, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @3, i32 0, i32 0), i32 %13, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @4, i32 0, i32 0)) + %13 = sext i32 %12 to i64 + %14 = load i32, i32* %x1, align 4 + %15 = add i32 25, %14 + %16 = sext i32 %15 to i64 + %17 = call i8* (i32, i8*, ...) @_lcompilers_string_format_fortran(i32 10, i8* null, i32 2, i64 %11, i32 2, i64 1, i32 2, i64 3, i32 2, i64 %13, i32 2, i64 %16) + call void (i8*, ...) @_lfortran_printf(i8* getelementptr inbounds ([5 x i8], [5 x i8]* @5, i32 0, i32 0), i8* %17, i8* getelementptr inbounds ([2 x i8], [2 x i8]* @4, i32 0, i32 0)) br label %return return: ; preds = %.entry diff --git a/tests/reference/run-print3-b6beca0.json b/tests/reference/run-print3-b6beca0.json index 61c3daa7ec..cd5e6fa9b6 100644 --- a/tests/reference/run-print3-b6beca0.json +++ b/tests/reference/run-print3-b6beca0.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "run-print3-b6beca0.stdout", - "stdout_hash": "7c21b856c7d57d23e4c5b7e5b7b5dd37d8cf077a8a5fe5826558f4e1", + "stdout_hash": "b7a8e92f3ad654f0db00b67a50310de56893a8ef6bcf296f40cdece5", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/run-print3-b6beca0.stdout b/tests/reference/run-print3-b6beca0.stdout index fe7c45a7cb..8cece47e1e 100644 --- a/tests/reference/run-print3-b6beca0.stdout +++ b/tests/reference/run-print3-b6beca0.stdout @@ -1,4 +1,4 @@ x is 24 - x is 24 + x is 24 ok ok