diff --git a/integration_tests/CMakeLists.txt b/integration_tests/CMakeLists.txt index b93923c4c5..bd83eca538 100644 --- a/integration_tests/CMakeLists.txt +++ b/integration_tests/CMakeLists.txt @@ -1029,7 +1029,7 @@ RUN(NAME implicit_interface_12 LABELS gfortran llvmImplicit) RUN(NAME implicit_interface_13 LABELS gfortran llvmImplicit) RUN(NAME implicit_interface_14 LABELS gfortran) # ! TODO: fix this test RUN(NAME implicit_interface_15 LABELS gfortran llvm2 EXTRA_ARGS --implicit-interface EXTRAFILES implicit_interface_15b) - +RUN(NAME implicit_interface_16 LABELS gfortran llvm2 EXTRA_ARGS --implicit-interface EXTRAFILES implicit_interface_16b) RUN(NAME implicit_typing_01 LABELS gfortran llvmImplicit) RUN(NAME implicit_typing_02 LABELS gfortran llvmImplicit) diff --git a/integration_tests/implicit_interface_16.f90 b/integration_tests/implicit_interface_16.f90 new file mode 100644 index 0000000000..d3df417107 --- /dev/null +++ b/integration_tests/implicit_interface_16.f90 @@ -0,0 +1,13 @@ +program implicit_interface_16 + +implicit none + +real :: v(4) +logical, external :: sisnan + +v = [1.0, 2.0, 3.0, 4.0] + +print *, sisnan( v( 1 ) ) +if( sisnan( v( 1 ) ) ) error stop + +end program diff --git a/integration_tests/implicit_interface_16b.f90 b/integration_tests/implicit_interface_16b.f90 new file mode 100644 index 0000000000..cf91e67159 --- /dev/null +++ b/integration_tests/implicit_interface_16b.f90 @@ -0,0 +1,6 @@ +logical function sisnan( sin ) +real, intent(in) :: sin + +sisnan = (sin.ne.sin) +return +end diff --git a/src/lfortran/semantics/ast_common_visitor.h b/src/lfortran/semantics/ast_common_visitor.h index 0613a44355..ef6c7b186b 100644 --- a/src/lfortran/semantics/ast_common_visitor.h +++ b/src/lfortran/semantics/ast_common_visitor.h @@ -1997,7 +1997,7 @@ class CommonVisitor : public AST::BaseVisitor { } } - void create_external_function(std::string sym, Location loc) { + void create_external_function(std::string sym, Location loc, ASR::ttype_t* determined_type = nullptr) { if (compiler_options.implicit_interface) { bool is_subroutine = false; external_procedures.push_back(sym); @@ -2016,6 +2016,9 @@ class CommonVisitor : public AST::BaseVisitor { if (!is_subroutine) { type = ASRUtils::symbol_type(sym_); } + } else if (determined_type) { + // if explicit type provided, give preference to it. + type = determined_type; } else if (compiler_options.implicit_typing) { type = implicit_dictionary[std::string(1,sym[0])]; if (!type) { @@ -2566,6 +2569,7 @@ class CommonVisitor : public AST::BaseVisitor { AST::var_sym_t &s = x.m_syms[i]; std::string sym = to_lower(s.m_name); bool is_external = check_is_external(sym); + bool is_attr_external = false; ASR::accessType s_access = dflt_access; ASR::presenceType s_presence = dflt_presence; ASR::storage_typeType storage_type = dflt_storage; @@ -2694,7 +2698,7 @@ class CommonVisitor : public AST::BaseVisitor { excluded_from_symtab.push_back(sym); } else if(sa->m_attr == AST::simple_attributeType ::AttrExternal) { - create_external_function(sym, x.m_syms[i].loc); + is_attr_external = true; assgnd_access[sym] = ASR::accessType::Public; if (assgnd_access.count(sym)) { s_access = assgnd_access[sym]; @@ -2757,6 +2761,7 @@ class CommonVisitor : public AST::BaseVisitor { ASR::ttype_t *type = determine_type(x.base.base.loc, sym, x.m_vartype, is_pointer, is_allocatable, dims, type_declaration, s_abi, (s_intent != ASRUtils::intent_local) || is_argument, is_dimension_star); + if ( is_attr_external ) create_external_function(sym, x.m_syms[i].loc, type); current_variable_type_ = type; ASR::expr_t* init_expr = nullptr; diff --git a/tests/reference/asr-external_01-6754623.json b/tests/reference/asr-external_01-6754623.json index 858040afd7..b0cfa7669f 100644 --- a/tests/reference/asr-external_01-6754623.json +++ b/tests/reference/asr-external_01-6754623.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-external_01-6754623.stdout", - "stdout_hash": "70c4de75907cc99a508ddf4fe9a7203722cf43e8988c510983937ba7", + "stdout_hash": "c003e8a7f2798614252fa50c056219c97076f75f66fc1bc9d975452f", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-external_01-6754623.stdout b/tests/reference/asr-external_01-6754623.stdout index f074a55446..aeca94ee85 100644 --- a/tests/reference/asr-external_01-6754623.stdout +++ b/tests/reference/asr-external_01-6754623.stdout @@ -69,7 +69,7 @@ () () Default - (Real 4) + (Complex 4) () BindC Public @@ -80,7 +80,7 @@ f (FunctionType [(Complex 4)] - (Real 4) + (Complex 4) BindC Interface () @@ -108,7 +108,7 @@ (Complex 4) (FunctionType [] - (Real 4) + (Complex 4) BindC Interface () @@ -138,18 +138,13 @@ (Var 2 f)] [(Assignment (Var 2 a) - (Cast - (FunctionCall - 2 f - () - [((Var 2 b))] - (Real 4) - () - () - ) - RealToComplex + (FunctionCall + 2 f + () + [((Var 2 b))] (Complex 4) () + () ) () )] diff --git a/tests/reference/asr-intrinsics_02-eb20326.json b/tests/reference/asr-intrinsics_02-eb20326.json deleted file mode 100644 index 2047b4668b..0000000000 --- a/tests/reference/asr-intrinsics_02-eb20326.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "basename": "asr-intrinsics_02-eb20326", - "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}", - "infile": "tests/errors/intrinsics_02.f90", - "infile_hash": "5f9e65831d5f5364221b0dcd48a8b2c564706dd06b00318116f21337", - "outfile": null, - "outfile_hash": null, - "stdout": null, - "stdout_hash": null, - "stderr": "asr-intrinsics_02-eb20326.stderr", - "stderr_hash": "269e7974bceb6a1c2b1da260030b5b1edb394fd1eda2c1a2c58af0f8", - "returncode": 2 -} \ No newline at end of file diff --git a/tests/reference/asr-intrinsics_02-eb20326.stderr b/tests/reference/asr-intrinsics_02-eb20326.stderr deleted file mode 100644 index 2fd04d6da9..0000000000 --- a/tests/reference/asr-intrinsics_02-eb20326.stderr +++ /dev/null @@ -1,5 +0,0 @@ -semantic error: datan2 was declared as a variable, it can't be called as a function - --> tests/errors/intrinsics_02.f90:5:14 - | -5 | print *, datan2(x,y) - | ^^^^^^^^^^^ help: use the compiler option "--implicit-interface" to use intrinsic functions diff --git a/tests/reference/asr-intrinsics_03-f6b3e89.json b/tests/reference/asr-intrinsics_03-f6b3e89.json deleted file mode 100644 index 82e5214f7a..0000000000 --- a/tests/reference/asr-intrinsics_03-f6b3e89.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "basename": "asr-intrinsics_03-f6b3e89", - "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}", - "infile": "tests/errors/intrinsics_03.f90", - "infile_hash": "a3f866a760dc1359180fb91d5150d38e17b804e972212af61e1bc015", - "outfile": null, - "outfile_hash": null, - "stdout": null, - "stdout_hash": null, - "stderr": "asr-intrinsics_03-f6b3e89.stderr", - "stderr_hash": "904b086dfa94bb986d8b87e22d17297c569d448babe5fc43044237b5", - "returncode": 2 -} \ No newline at end of file diff --git a/tests/reference/asr-intrinsics_03-f6b3e89.stderr b/tests/reference/asr-intrinsics_03-f6b3e89.stderr deleted file mode 100644 index 2d08bf1660..0000000000 --- a/tests/reference/asr-intrinsics_03-f6b3e89.stderr +++ /dev/null @@ -1,5 +0,0 @@ -semantic error: `pos` argument of `ibclr` intrinsic must be non-negative - --> tests/errors/intrinsics_03.f90:2:14 - | -2 | print *, ibclr(1, -2) - | ^^^^^^^^^^^^ diff --git a/tests/reference/asr-intrinsics_04-fbc7b3a.json b/tests/reference/asr-intrinsics_04-fbc7b3a.json deleted file mode 100644 index c61df28c50..0000000000 --- a/tests/reference/asr-intrinsics_04-fbc7b3a.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "basename": "asr-intrinsics_04-fbc7b3a", - "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}", - "infile": "tests/errors/intrinsics_04.f90", - "infile_hash": "5a2801f3caef8c6df8fe201070cb5cb553ef28ba42ac97cb7d0e5433", - "outfile": null, - "outfile_hash": null, - "stdout": null, - "stdout_hash": null, - "stderr": "asr-intrinsics_04-fbc7b3a.stderr", - "stderr_hash": "a31b408638dd6187d1e48eb4f233d3cc5412afc3640eba864e65ed24", - "returncode": 2 -} \ No newline at end of file diff --git a/tests/reference/asr-intrinsics_04-fbc7b3a.stderr b/tests/reference/asr-intrinsics_04-fbc7b3a.stderr deleted file mode 100644 index 2eddd7eadb..0000000000 --- a/tests/reference/asr-intrinsics_04-fbc7b3a.stderr +++ /dev/null @@ -1,5 +0,0 @@ -semantic error: The kind of first argument of `iand` intrinsic must be the same as second argument - --> tests/errors/intrinsics_04.f90:2:14 - | -2 | print *, iand(1, 1_8) - | ^^^^^^^^^^^^ diff --git a/tests/reference/asr-intrinsics_05-a2b71c6.json b/tests/reference/asr-intrinsics_05-a2b71c6.json deleted file mode 100644 index 0cfd639ef8..0000000000 --- a/tests/reference/asr-intrinsics_05-a2b71c6.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "basename": "asr-intrinsics_05-a2b71c6", - "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}", - "infile": "tests/errors/intrinsics_05.f90", - "infile_hash": "a0b26c89376dc415c9180441ee41b111288a075487d7393f2d5e77e4", - "outfile": null, - "outfile_hash": null, - "stdout": null, - "stdout_hash": null, - "stderr": "asr-intrinsics_05-a2b71c6.stderr", - "stderr_hash": "3a73f12ef5c63f13adf2e3a2e6962f4fe4799ce80d2d3e9de7dd5ad1", - "returncode": 2 -} \ No newline at end of file diff --git a/tests/reference/asr-intrinsics_05-a2b71c6.stderr b/tests/reference/asr-intrinsics_05-a2b71c6.stderr deleted file mode 100644 index 7eab0147cc..0000000000 --- a/tests/reference/asr-intrinsics_05-a2b71c6.stderr +++ /dev/null @@ -1,5 +0,0 @@ -semantic error: The kind of first argument of `ior` intrinsic must be the same as second argument - --> tests/errors/intrinsics_05.f90:2:14 - | -2 | print *, ior(1, 1_8) - | ^^^^^^^^^^^ diff --git a/tests/reference/asr-intrinsics_06-1ff7a26.json b/tests/reference/asr-intrinsics_06-1ff7a26.json deleted file mode 100644 index 124d63706d..0000000000 --- a/tests/reference/asr-intrinsics_06-1ff7a26.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "basename": "asr-intrinsics_06-1ff7a26", - "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}", - "infile": "tests/errors/intrinsics_06.f90", - "infile_hash": "2cae4d6194dc457cd08420747ec727afd75ae55121f2c54a6fccaddc", - "outfile": null, - "outfile_hash": null, - "stdout": null, - "stdout_hash": null, - "stderr": "asr-intrinsics_06-1ff7a26.stderr", - "stderr_hash": "665421d7b10c6357c50c82c965a770fc5686c3e99bfcc94080069899", - "returncode": 2 -} \ No newline at end of file diff --git a/tests/reference/asr-intrinsics_06-1ff7a26.stderr b/tests/reference/asr-intrinsics_06-1ff7a26.stderr deleted file mode 100644 index a06bfcd018..0000000000 --- a/tests/reference/asr-intrinsics_06-1ff7a26.stderr +++ /dev/null @@ -1,5 +0,0 @@ -semantic error: The kind of first argument of `ieor` intrinsic must be the same as second argument - --> tests/errors/intrinsics_06.f90:2:14 - | -2 | print *, ieor(1, 1_8) - | ^^^^^^^^^^^^ diff --git a/tests/reference/asr-merge_bits_run-9579699.stdout b/tests/reference/asr-merge_bits_run-9579699.stdout deleted file mode 100644 index 20c217ad3c..0000000000 --- a/tests/reference/asr-merge_bits_run-9579699.stdout +++ /dev/null @@ -1,92 +0,0 @@ -(TranslationUnit - (SymbolTable - 1 - { - merge_bits_comp: - (Program - (SymbolTable - 2 - { - a: - (Variable - 2 - a - [] - Local - () - () - Default - (Integer 4) - () - Source - Public - Required - .false. - ), - b: - (Variable - 2 - b - [] - Local - () - () - Default - (Integer 8) - () - Source - Public - Required - .false. - ), - c: - (Variable - 2 - c - [] - Local - () - () - Default - (Integer 4) - () - Source - Public - Required - .false. - ) - }) - merge_bits_comp - [] - [(Assignment - (Var 2 a) - (IntegerConstant 8 (Integer 4)) - () - ) - (Assignment - (Var 2 b) - (IntegerConstant 12 (Integer 8)) - () - ) - (Assignment - (Var 2 c) - (IntegerConstant 2 (Integer 4)) - () - ) - (Print - [(IntrinsicElementalFunction - Mergebits - [(Var 2 a) - (Var 2 b) - (Var 2 c)] - 0 - (Integer 4) - () - )] - () - () - )] - ) - }) - [] -)