return *symbol;
}
+ /// Return a pointer to the main program symbol for named programs
+ /// Return the null pointer for anonymous programs
+ const semantics::Symbol *getMainProgramSymbol() const {
+ if (!isMainProgram()) {
+ llvm::report_fatal_error("call only on main program.");
+ }
+ return entryPointList[activeEntry].first;
+ }
+
/// Return a pointer to the current entry point Evaluation.
/// This is null for a primary entry point.
Evaluation *getEntryEval() const {
const Fortran::semantics::Symbol *
Fortran::lower::CalleeInterface::getProcedureSymbol() const {
if (funit.isMainProgram())
- return nullptr;
+ return funit.getMainProgramSymbol();
return &funit.getSubprogramSymbol();
}
mlir::Location loc = side().getCalleeLocation();
mlir::FunctionType ty = genFunctionType();
func = fir::FirOpBuilder::createFunction(loc, module, name, ty);
- if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol())
- addSymbolAttribute(func, *sym, converter.getMLIRContext());
+ if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol()) {
+ if (side().isMainProgram()) {
+ func->setAttr(fir::getSymbolAttrName(),
+ mlir::StringAttr::get(&converter.getMLIRContext(),
+ sym->name().ToString()));
+ } else {
+ addSymbolAttribute(func, *sym, converter.getMLIRContext());
+ }
+ }
for (const auto &placeHolder : llvm::enumerate(inputs))
if (!placeHolder.value().attributes.empty())
func.setArgAttrs(placeHolder.index(), placeHolder.value().attributes);
! This test checks the lowering of atomic read
-!CHECK: func @_QQmain() {
+!CHECK: func @_QQmain() attributes {fir.bindc_name = "ompatomic"} {
!CHECK: %[[VAR_A:.*]] = fir.alloca !fir.char<1> {bindc_name = "a", uniq_name = "_QFEa"}
!CHECK: %[[VAR_B:.*]] = fir.alloca !fir.char<1> {bindc_name = "b", uniq_name = "_QFEb"}
!CHECK: %[[VAR_C:.*]] = fir.alloca !fir.logical<4> {bindc_name = "c", uniq_name = "_QFEc"}
a=>c
b=>d
-!CHECK: func.func @_QQmain() {
+!CHECK: func.func @_QQmain() attributes {fir.bindc_name = "ompatomicupdate"} {
!CHECK: %[[A:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "a", uniq_name = "_QFEa"}
!CHECK: %[[A_ADDR:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFEa.addr"}
!CHECK: %{{.*}} = fir.zero_bits !fir.ptr<i32>
! This test checks the lowering of atomic write
-!CHECK: func @_QQmain() {
+!CHECK: func @_QQmain() attributes {fir.bindc_name = "ompatomicwrite"} {
!CHECK: %[[VAR_X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFEx"}
!CHECK: %[[VAR_Y:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFEy"}
!CHECK: %[[VAR_Z:.*]] = fir.alloca i32 {bindc_name = "z", uniq_name = "_QFEz"}
! RUN: bbc -fopenmp -emit-fir %s -o - | FileCheck %s
-!CHECK: func @_QQmain() {
+!CHECK: func @_QQmain() attributes {fir.bindc_name = "default_clause_lowering"} {
!CHECK: %[[W:.*]] = fir.alloca i32 {bindc_name = "w", uniq_name = "_QFEw"}
!CHECK: %[[X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFEx"}
!CHECK: %[[Y:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFEy"}
integer :: i
integer :: chunk
-! CHECK-LABEL: func.func @_QQmain() {
+! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "wsloop"} {
! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "chunk", uniq_name = "_QFEchunk"}
!$OMP DO SCHEDULE(static, 4)
! RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s
-!CHECK: func @_QQmain() {
+!CHECK: func @_QQmain() attributes {fir.bindc_name = "sample"} {
!CHECK: %[[COUNT:.*]] = fir.address_of(@_QFEcount) : !fir.ref<i32>
!CHECK: %[[ETA:.*]] = fir.alloca f32 {bindc_name = "eta", uniq_name = "_QFEeta"}
!CHECK: %[[CONST_1:.*]] = arith.constant 1 : i32
! CHECK: }
end subroutine
-! CHECK-LABEL: func @_QQmain() {
+! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "p"} {
program p
! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 4 : index
! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 3 : index
! RUN: bbc -o - --outline-intrinsics %s | FileCheck %s
-! CHECK-LABEL: func @_QQmain() {
+! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "p"} {
! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 10 : index
! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 2 : index
! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 1 : index
! CHECK: 1 EndProgramStmt: end program
! CHECK: End Program basic
-! FIR-LABEL: func @_QQmain() {
+! FIR-LABEL: func @_QQmain() attributes {fir.bindc_name = "basic"} {
! FIR: return
! FIR: }
print*,y
end
-! CHECK-LABEL: func.func @_QQmain() {
+! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "i128"} {
! CHECK-COUNT-2: %{{.*}} = fir.call @_FortranAioOutputInteger128(%{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<i8>, i128) -> i1
print *, 'end of program'
end program
-! CHECK-LABEL: func.func @_QQmain() {
+! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "p"} {
! CHECK: %[[T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QFEt"}
! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
! CHECK: ^bb1:
! RUN: bbc -emit-fir %s -o - | FileCheck %s
-! CHECK-LABEL: func @_QQmain() {
+! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "nested_where"} {
program nested_where
! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
l = i < o%inner
end program
-! CHECK-LABEL: func.func @_QQmain() {
+! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "test"} {
! CHECK: %[[ADDR_O:.*]] = fir.address_of(@_QFEo) : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>>
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ADDR_O]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: }
end subroutine
-! CHECK-LABEL: func @_QQmain() {
+! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "test"} {
program test
! CHECK: }
contains
return
end program
-! CHECK-LABEL: func @_QQmain() {
+! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "basic"} {
! CHECK: return
! CHECK: }