Merge pull request lfortran#4462 from Pranavchiku/gh4441

enh: handle explicit type handling in creation of external function.
KGB99 · Jul 11, 2024 · 1685339 · 1685339
2 parents 6f1257a + b41beb4
commit 1685339
Show file tree

Hide file tree

Showing 17 changed files with 36 additions and 199 deletions.
diff --git 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
@@ -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
@@ -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
@@ -1997,7 +1997,7 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
         }
     }
 
-    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<Derived> {
                 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<Derived> {
                 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<Derived> {
                                 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<Derived> {
                 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
@@ -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
@@ -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
diff --git a/tests/reference/asr-intrinsics_02-eb20326.stderr b/tests/reference/asr-intrinsics_02-eb20326.stderr
diff --git a/tests/reference/asr-intrinsics_03-f6b3e89.json b/tests/reference/asr-intrinsics_03-f6b3e89.json
diff --git a/tests/reference/asr-intrinsics_03-f6b3e89.stderr b/tests/reference/asr-intrinsics_03-f6b3e89.stderr
diff --git a/tests/reference/asr-intrinsics_04-fbc7b3a.json b/tests/reference/asr-intrinsics_04-fbc7b3a.json
diff --git a/tests/reference/asr-intrinsics_04-fbc7b3a.stderr b/tests/reference/asr-intrinsics_04-fbc7b3a.stderr
diff --git a/tests/reference/asr-intrinsics_05-a2b71c6.json b/tests/reference/asr-intrinsics_05-a2b71c6.json
diff --git a/tests/reference/asr-intrinsics_05-a2b71c6.stderr b/tests/reference/asr-intrinsics_05-a2b71c6.stderr
diff --git a/tests/reference/asr-intrinsics_06-1ff7a26.json b/tests/reference/asr-intrinsics_06-1ff7a26.json
diff --git a/tests/reference/asr-intrinsics_06-1ff7a26.stderr b/tests/reference/asr-intrinsics_06-1ff7a26.stderr
diff --git a/tests/reference/asr-merge_bits_run-9579699.stdout b/tests/reference/asr-merge_bits_run-9579699.stdout