Misc fixes

src/caffeine/caffeine.c

@@ -63,14 +63,14 @@ int caf_num_images(gex_TM_t tm) {
 // Given team and corresponding image_num, return image number in the initial team
 int caf_image_to_initial(gex_TM_t tm, int image_num) {
   assert(image_num >= 1);
-  assert(image_num <= gex_TM_QuerySize(tm));
+  assert(image_num <= (int)gex_TM_QuerySize(tm));
   gex_Rank_t proc = gex_TM_TranslateRankToJobrank(tm, image_num-1);
   return proc + 1;
 }
 // Given image number in the initial team, return image number corresponding to given team
 int caf_image_from_initial(gex_TM_t tm, int image_num) {
   assert(image_num >= 1);
-  assert(image_num <= numprocs);
+  assert(image_num <= (int)numprocs);
   gex_Rank_t proc = gex_TM_TranslateJobrankToRank(tm, image_num-1);
   // GEX_RANK_INVALID indicates the provided image_num in initial team is not part of tm
   assert(proc != GEX_RANK_INVALID); 
@@ -405,7 +405,7 @@ static void atomic_init(void) {
 void caf_atomic_int(int opcode, int image, void* addr, int64_t *result, int64_t op1, int64_t op2) {
   assert(atomic_AD != GEX_AD_INVALID);
   assert(addr);
-  assert(opcode >= 0 && opcode < sizeof(op_map)/sizeof(op_map[0]));
+  assert(opcode >= 0 && opcode < (int)(sizeof(op_map)/sizeof(op_map[0])));
 
   gex_OP_t op = op_map[opcode];
   gex_Event_Wait(
@@ -428,6 +428,13 @@ void caf_atomic_logical(int opcode, int image, void* addr, int64_t *result, int6
 }
 
 //-------------------------------------------------------------------
+// gfortran 13.2 .. 15 : c_funloc is non-compliant
+// it erroneously generates a non-callable pointer to a pointer to the subroutine
+// This helper is used to undo that incorrect extra level of indirection
+typedef void (*funloc_t)(void);
+funloc_t caf_c_funloc_deref(funloc_t funloc) {
+  return *(funloc_t *)funloc;
+}
 
 void caf_co_reduce(
   CFI_cdesc_t* a_desc, int result_image, size_t num_elements, gex_Coll_ReduceFn_t user_op, void* client_data, gex_TM_t team
@@ -436,12 +443,7 @@ void caf_co_reduce(
   assert(result_image >= 0);
   assert(num_elements > 0);
   assert(user_op);
-#if PLATFORM_COMPILER_GNU
-  // gfortran 13.2 & 14 - c_funloc is non-compliant
-  // it erroneously generates a non-callable pointer to a pointer to the subroutine
-  // Here we undo that incorrect extra level of indirection
-  user_op = *(gex_Coll_ReduceFn_t *)user_op; 
-#endif
+
   char* a_address = (char*) a_desc->base_addr;
   size_t c_sizeof_a = a_desc->elem_len;
   gex_Event_t ev;
@@ -550,7 +552,7 @@ static int64_t *widen_from_array(CFI_cdesc_t* a_desc, size_t num_elements) {
   } else if (a_desc->elem_len == 2) {
     int16_t *src = a_desc->base_addr;
     for (size_t i=0; i < num_elements; i++) res[i] = src[i];
-  } else gasnett_fatalerror("Logic error in widen_from_array: %i", a_desc->elem_len);
+  } else gasnett_fatalerror("Logic error in widen_from_array: %i", (int)a_desc->elem_len);
   return res;
 }
 
@@ -564,7 +566,7 @@ static void narrow_to_array(CFI_cdesc_t* a_desc, int64_t *src, size_t num_elemen
   } else if (a_desc->elem_len == 2) {
     int16_t *dst = a_desc->base_addr;
     for (size_t i=0; i < num_elements; i++) dst[i] = src[i];
-  } else gasnett_fatalerror("Logic error in narrow_to_array: %i", a_desc->elem_len);
+  } else gasnett_fatalerror("Logic error in narrow_to_array: %i", (int)a_desc->elem_len);
   free(src);
 }
 

src/caffeine/co_reduce_s.F90

@@ -36,7 +36,13 @@ subroutine contiguous_co_reduce(a, operation_wrapper, cdata, result_image, stat,
 
     if (present(stat)) stat=0
 
-    funptr = c_funloc(operation_wrapper)
+#   if __GFORTRAN__
+      ! Gfortran 13..15 bug workaround
+      funptr = caf_c_funloc_deref(c_funloc(operation_wrapper))
+#   else
+      funptr = c_funloc(operation_wrapper)
+#   endif
+
     call_assert(c_associated(funptr))
 
     call caf_co_reduce( &

src/caffeine/coarray_queries_s.F90

@@ -58,8 +58,6 @@
   end procedure
 
   module procedure prif_coshape
-    integer(c_int64_t) :: trailing_ucobound
-
     call_assert(coarray_handle_check(coarray_handle))
     call_assert(size(sizes) == coarray_handle%info%corank)
 

src/caffeine/prif_private_s.F90

@@ -338,6 +338,15 @@ subroutine caf_form_team(current_team, new_team, team_number, new_index) bind(C)
       integer(c_int), intent(in), value :: new_index
      end subroutine
 
+    ! ______________ Misc helpers  __________________
+     function caf_c_funloc_deref(funloc) result(res) bind(C)
+       !! funloc_t caf_c_funloc_deref(funloc_t funloc)
+       import c_funptr
+       implicit none
+       type(c_funptr), value :: funloc
+       type(c_funptr) :: res
+     end function
+
   end interface
 
   interface num_to_str