<table border="1" cellspacing="0" cellpadding="8">
    <tr>
        <th>Issue</th>
        <td>
            <a href=https://github.com/llvm/llvm-project/issues/134567>134567</a>
        </td>
    </tr>

    <tr>
        <th>Summary</th>
        <td>
            [Flang] Incorrect execution result of EXTENDS_TYPE_OF intrinsic function
        </td>
    </tr>

    <tr>
      <th>Labels</th>
      <td>
            flang
      </td>
    </tr>

    <tr>
      <th>Assignees</th>
      <td>
      </td>
    </tr>

    <tr>
      <th>Reporter</th>
      <td>
          ohno-fj
      </td>
    </tr>
</table>

<pre>
    ```
Version of flang : 21.0.0(06cb7b1e14a117e8fe19b72689c8616c772c0807)/AArch64
```

As in the attached program, the two arguments supplied to `EXTENDS_TYPE_OF intrinsic function` appear to be different types defined in different modules. 
According to `Fortran Standard 2023: 16.9.86 EXTENDS_TYPE_OF (A, MOLD)`, the result is false if `dynamic type` of `first argument (dmyptr)` is not an `extension type` of the `dynamic type` of `the second argument (baseobj)`. 
Therefore, the execution result of Flang is probably incorrect.

The following are the test program, Flang, Gfortran and ifx compilation/execution result.

Polymorphism_2.f90:
```fortran
MODULE MODULE3
  IMPLICIT NONE
 LOGICAL::x
  TYPE base
     integer ::int1
  END TYPE base
  TYPE ,EXTENDS(base)::deriv
     INTEGER :: int2
  END TYPE deriv
END MODULE MODULE3

MODULE MODULE4
  IMPLICIT NONE
  TYPE base
     INTEGER ::ii
 END TYPE base
  TYPE ,EXTENDS(base):: deriv
     INTEGER :: kk
  END TYPE deriv
END MODULE

PROGRAM MAIN
  IMPLICIT NONE
  INTERFACE
 SUBROUTINE sub2
     END SUBROUTINE sub2
  END INTERFACE
  call sub2()
END PROGRAM MAIN

SUBROUTINE sub1(dmyptr)
  use MODULE3
 CLASS(*)::dmyptr
  TYPE(deriv)::baseobj
  LOGICAL::res
 res=EXTENDS_TYPE_OF(dmyptr,baseobj)
  print*,'res = ', res
  if(res .eqv. .false.) then
     print*,'pass'
  else
     print*,'fail'
  endif
END SUBROUTINE sub1

SUBROUTINE sub2()
  use MODULE4
  INTERFACE
 SUBROUTINE sub1(dmy1)
       CLASS(*)::dmy1
     END SUBROUTINE sub1
  end interface
  CLASS(base),POINTER::ptr_base
  TYPE(deriv),TARGET::tar_ty1
 ptr_base=>tar_ty1
  call sub1(ptr_base)
END SUBROUTINE sub2
```

```
$ flang Polymorphism_2.f90; ./a.out
 res =  T
 fail
$
```

```
$ gfortran Polymorphism_2.f90; ./a.out
 res =  F
 pass
$
```

```
$ ifx Polymorphism_2.f90; ./a.out
 res =  F
 pass
$
```

</pre>
<img width="1" height="1" alt="" src="http://email.email.llvm.org/o/eJysVlFv4jgQ_jXmxdrIcUIgDzxkgVRILVSUPd09VU5ig3eDnbOdbvn3p3ESCmx7vZWuqhTsmflm5pvPcZi1cq84n6HxVzRejFjrDtrM9EHpL-L7qNDVaYYS0v-T7A9urNQKa4FFzdQeoyjDNAxIQBCdkqQsJkXIw5iF4YRPBQ_TYkKTaVpOkzApJxNakimZIJoimmeZKQ9JjEh2mQGRLLNYKuwOHDPnWHngFW6M3ht2RHTu991PjZnZt0eunMW2bZpa8go7jVFCln_uluvF0_Pur8fl8ybHUjkjlZUlFq0qndQKJQSzpuHMQEjBcSWF4IYrh92p4RZXXEjFKyjjzXTUVVtzG2AosSy1qaTa9zlzbZxhCj85pipmKkwJjYCbMAnSYJrg26IQnWbQzcPmfgF0JGTozXDb1g5LiwWrLcdSQILqpNhRlr4-KF_7XSGNdWcmALQ6nhpnOkTAUNphpsCXvzqu_PAuMCDhh-hgtLzUqrpKUTDLdfG9y-HZ2B244UIbPvTAX3nZAtNDN1rg3OtFWphlwYr6hKUqtTG8dEE3992BY6HrWv8EYpnh3ay5dZfz9zjw4070pDNVYSlecamPjayZnzDNb2vokzzq-nTUpjlIe3ymgUgJirJLDfaoiGQPm8W3-yXuHhEiGcarh8f71Xy1w-vNegk795u71Ty7B4woe_U-MGIMJPkVxiBAvucGd05SudBbluvFja9fITrvxdJzDUT7yIob-TKArta75d1y24NCDnqNOnjDxi-d3HYXv9_dr71cp5US9n-7Efxvnfz48Vkf_SC3m7tt9oAfstX6g-oBeZtnc796-vZ1u_m2W62X2LYFHbID7Hsm2L-KxyWr685Op9BKV9JNGYhk12jh1aEEnNbyS03N77OnJw-ZvU26CxioBAjPwmAfjiA4XCnQcAub8IgWN--ci0LmF2cYMBojlfMFzBGdGG4xihYY0Qmcsx4TS4HoFGwB__slwIF_PQWIpnBM1cDnNVTDrAUYMPL6TUbXXoLJ-uylKil6bm-ZfIfet2FcEht_Nv5-KuEQ6v8-mET4sVTCoWR_xo1gZdfhgDSons4fN76aDrRx5vnqrFwOmM532fZuuetcHTPPrivhHBUtULS8MJyVCV2dvc4K_VXdN_ft1ZLG_c3-3ovyKw4QzVmgW9fLzAsF72Dlp-gRPk-xH97dv5Ml9yyAov5jFrgU_r8Eo2oWVWmUshGfhZM4StOIxGR0mPFqLJIqJHFCWULDVBTTKCFTUsVMjElajuSMEjomMZkQCjGBIOW4IiSJWFGkMR-jmPAjk3VQ1y_HQJv9SFrb8lkYxeNkMqpZwWvrv9EoFd39R-Fzzcwg4EvR7i2KSS2ts28QTrraf9h1N-Z4gVfDhfvuBf35d9OoNfXs4FxjQZw0RzTfS3doi6DUR0RzSN0_vjRGf-elQzT3rVhE876blxn9JwAA__-0aAnh">