Merge pull request lfortran#4604 from HarshitaKalani/sign_01

Throw error for different kind of args in `sign` and update integration test

integration_tests/CMakeLists.txt

@@ -872,6 +872,7 @@ RUN(NAME intrinsics_297 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # poppar
 RUN(NAME intrinsics_298 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc fortran) # dot_product
 RUN(NAME intrinsics_299 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # command_argument_count
 RUN(NAME intrinsics_300 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # kind
+RUN(NAME intrinsics_304 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # sign
 
 RUN(NAME passing_array_01 LABELS gfortran fortran llvm llvm_wasm llvm_wasm_emcc)
 RUN(NAME passing_array_02 LABELS gfortran fortran llvm llvm_wasm llvm_wasm_emcc)

integration_tests/intrinsics_304.f90

@@ -0,0 +1,72 @@
+program intrinsics_304
+    implicit none
+    integer, parameter :: a1 = sign(1, 1)
+    integer(8), parameter :: a2 = sign(1, -1)
+    integer, parameter :: a3 = sign(-13, 0)
+    integer(8), parameter :: a4 = sign(0, 42)
+    real, parameter :: a5 = sign(1.425, 3.0)
+    real(8), parameter :: a6 = sign(1.425, -3.0)
+    real, parameter :: a7 = sign(1.425, 0.0)
+    real(8), parameter :: a8 = sign(0.0, -3.0)
+
+    integer, parameter :: ar1(3) = sign([1, 2, 3], [1, 2, 3])
+    integer(8), parameter :: ar2(3) = sign([1, -2, 3], -3)
+    real, parameter :: ar3(3) = sign([1.425, -2.425, 3.425], 3.0)
+    real(8), parameter :: ar4(3) = sign([1.425, -2.425, 3.425], 3.0)
+
+    integer :: x1 = 123, x2 = -90
+    integer(8) :: x3 = 123, x4 = 423
+    real :: x5 = 123.0, x6 = -47981
+    real(8) :: x7 = 123.0, x8 = 123.0
+
+    integer :: arr1(3) = [-311, -241, 331], arr2(3) = [1, 2, 3]
+    real :: arr3(3) = [1.425, -2.425, 3.425], arr4(3) = [1.425, -2.425, 3.425]
+
+    print *, a1
+    if (a1 /= 1) error stop
+    print *, a2
+    if (a2 /= -1) error stop
+    print *, a3
+    if (a3 /= 13) error stop
+    print *, a4
+    if (a4 /= 0) error stop
+    print *, a5
+    if (a5 /= 1.425) error stop
+    print *, a6
+    if (a6 /= -1.425) error stop
+    print *, a7
+    if (a7 /= 1.425) error stop
+    print *, a8
+    if (a8 /= -0.0) error stop
+
+    print *, ar1
+    if (any(ar1 /= [1, 2, 3])) error stop
+    print *, ar2
+    if (any(ar2 /= [-1, -2, -3])) error stop
+    print *, ar3
+    if (any(ar3 /= [1.42499995e+00, 2.42499995e+00, 3.42499995e+00])) error stop
+    print *, ar4
+    if (any(ar4 /= [1.42499995231628418e+00, 2.42499995231628418e+00, 3.42499995231628418e+00])) error stop
+
+    print *, sign(x1, x2)
+    if (sign(x1, x2) /= -123) error stop
+    print *, sign(x3, x4)
+    if (sign(x3, x4) /= 123) error stop
+    print *, sign(x5, x6)
+    if (sign(x5, x6) /= -123.0) error stop
+    print *, sign(x7, x8)
+    if (sign(x7, x8) /= 123.0) error stop
+
+    print *, sign(arr1, arr2)
+    if (any(sign(arr1, arr2) /= [311, 241, 331])) error stop
+    print *, sign(arr3, arr4)
+    if (any(sign(arr3, arr4) /= [1.425, -2.425, 3.425])) error stop
+
+    print *, sign(a=-12.,b=0.)
+    print *, sign(a=-12.,b=1.)
+    print *, sign(a=-12.,b=-1.)
+
+    if ( .not. sign( a = -12, b = 1 ) == 12 ) error stop
+    if ( .not. sign( -12, b = 0 ) == 12 ) error stop
+    if ( .not. sign( -12, -1 ) == -12 ) error stop
+end program

integration_tests/string_16.f90

@@ -1,23 +1,85 @@
 program string_16
     implicit none
+    character, parameter :: exclamation_1 = achar(33)
+    character, parameter :: dollar_1 = achar(36)
+    character, parameter :: left_parenthesis_1 = achar(40)
+    character, parameter :: plus_1 = achar(43)
+    character, parameter :: zero_1 = achar(48)
+    character, parameter :: nine_1 = achar(57)
+    character, parameter :: semicolon_1 = achar(59)
+    character, parameter :: capital_a_1 = achar(65)
+    character, parameter :: capital_z_1 = achar(90)
+    character, parameter :: right_bracket_1 = achar(93)
+    character, parameter :: small_a_1 = achar(97)
+    character, parameter :: small_z_1 = achar(122)
+    character, parameter :: right_brace_1 = achar(125)
 
-    character :: exclamation = achar(33)
-    character :: dollar = achar(36)
-    character :: left_parenthesis = achar(40)
-    character :: plus = achar(43)
-    character :: zero = achar(48)
-    character :: nine = achar(57)
-    character :: semicolon = achar(59)
-    character :: capital_a = achar(65)
-    character :: capital_z = achar(90)
-    character :: right_bracket = achar(93)
-    character :: small_a = achar(97)
-    character :: small_z = achar(122)
-    character :: right_brace = achar(125)
+    character, parameter :: ar1(5) = achar([33, 36, 40, 43, 48])
+    character, parameter :: ar2(5) = achar([57, 59, 65, 90, 93], 1)
+
+    character :: exclamation
+    character :: dollar
+    character :: left_parenthesis
+    character :: plus
+    character :: zero
+    character :: nine
+    character :: semicolon
+    character :: capital_a
+    character :: capital_z
+    character :: right_bracket
+    character :: small_a
+    character :: small_z
+    character :: right_brace
 
     integer :: a1 = 35
     integer :: a2(3) = [39, 63, 66]
 
+    exclamation = achar(33)
+    dollar = achar(36)
+    left_parenthesis = achar(40)
+    plus = achar(43)
+    zero = achar(48)
+    nine = achar(57)
+    semicolon = achar(59)
+    capital_a = achar(65)
+    capital_z = achar(90)
+    right_bracket = achar(93)
+    small_a = achar(97)
+    small_z = achar(122)
+    right_brace = achar(125)
+
+    print *, exclamation_1
+    if (exclamation_1 /= '!') error stop
+    print *, dollar_1
+    if (dollar_1 /= '$') error stop
+    print *, left_parenthesis_1
+    if (left_parenthesis_1 /= '(') error stop
+    print *, plus_1
+    if (plus_1 /= '+') error stop
+    print *, zero_1
+    if (zero_1 /= '0') error stop
+    print *, nine_1
+    if (nine_1 /= '9') error stop
+    print *, semicolon_1
+    if (semicolon_1 /= ';') error stop
+    print *, capital_a_1
+    if (capital_a_1 /= 'A') error stop
+    print *, capital_z_1
+    if (capital_z_1 /= 'Z') error stop
+    print *, right_bracket_1
+    if (right_bracket_1 /= ']') error stop
+    print *, small_a_1
+    if (small_a_1 /= 'a') error stop
+    print *, small_z_1
+    if (small_z_1 /= 'z') error stop
+    print *, right_brace_1
+    if (right_brace_1 /= '}') error stop
+
+    print *, ar1
+    if (any(ar1 /= ['!', '$', '(', '+', '0'])) error stop
+    print *, ar2
+    if (any(ar2 /= ['9', ';', 'A', 'Z', ']'])) error stop
+
     print*, achar(65)
     if (achar(65) /= 'A') error stop
 

src/libasr/intrinsic_func_registry_util_gen.py

@@ -247,7 +247,8 @@
     "Sign": [
         {
             "args": [("int", "int"), ("real", "real")],
-            "ret_type_arg_idx": 0
+            "ret_type_arg_idx": 0,
+            "same_kind_arg": 2
         },
     ],
     "Radix": [

tests/errors/sign_01.f90

@@ -0,0 +1,3 @@
+program main
+    print *, sign(1, 1_8)
+end program

tests/reference/asr-sign_01-62b270e.json

@@ -0,0 +1,13 @@
+{
+    "basename": "asr-sign_01-62b270e",
+    "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}",
+    "infile": "tests/errors/sign_01.f90",
+    "infile_hash": "467c2bd094955c085a80d6f4eb00ad122dfb895a2327a02ae62f1836",
+    "outfile": null,
+    "outfile_hash": null,
+    "stdout": null,
+    "stdout_hash": null,
+    "stderr": "asr-sign_01-62b270e.stderr",
+    "stderr_hash": "dab94d75469b4260c70326c06698d247c7f9bbe6c0aeebd631d20ab0",
+    "returncode": 2
+}

tests/reference/asr-sign_01-62b270e.stderr

@@ -0,0 +1,5 @@
+semantic error: Kind of all the arguments of Sign must be the same
+ --> tests/errors/sign_01.f90:2:14
+  |
+2 |     print *, sign(1, 1_8)
+  |              ^^^^^^^^^^^^ 

tests/tests.toml

@@ -4105,3 +4105,7 @@ asr = true
 [[test]]
 filename = "errors/modulo_01.f90"
 asr = true
+
+[[test]]
+filename = "errors/sign_01.f90"
+asr = true