Re: Documentation for the REDUCE intrinsic

[Sandra Loosemore]

On 4/12/25 01:10, Paul Richard Thomas wrote:

Hi All,

Now that the reduce intrinsic seems to be OK on all platforms, I thought 
that it was time to catch up with the documentation.


The attached produces good .html without any additional warnings or 
errors using texi2any and ~/share/info/gfortran.info 
 is as intended.


OK for mainline?


I took a look at this and it has some pretty substantial 
formatting/markup issues (I routinely inspect PDF output rather than the 
HTML or info since it's more prone to problems).  I'll see what I can do 
to fix it and get back to you hopefully in a day or two; it's going to 
take some trial and error, and it's likely more efficient for me to do 
this than to try to explain to you what to try where.


Also, I assume the "AR41 RAY" is a typo and "ARRAY" is meant there.

-Sandra

[PUSHED] Fortran: Add code gen for do, concurrent's LOCAL/LOCAL_INIT: Fix 'static_assert' [PR101602]

[Thomas Schwinge]

Fix-up for commit 2d7e1d6e40a13a5f160b584336795b80f193ec3b
"Fortran: Add code gen for do,concurrent's LOCAL/LOCAL_INIT [PR101602]":

../../source-gcc/gcc/fortran/trans-stmt.cc: In function ‘void 
gfc_trans_concurrent_locality_spec(bool, stmtblock_t*, 
std::vector*, gfc_expr_list**)’:
../../source-gcc/gcc/fortran/trans-stmt.cc:5157:59: error: expected ‘,’ 
before ‘)’ token
   static_assert (LOCALITY_LOCAL_INIT - LOCALITY_LOCAL == 1);
   ^
../../source-gcc/gcc/fortran/trans-stmt.cc:5157:59: error: expected 
string-literal before ‘)’ token
make[2]: *** [Makefile:1210: fortran/trans-stmt.o] Error 1

PR fortran/101602
gcc/fortran/
* trans-stmt.cc (gfc_trans_concurrent_locality_spec): Fix
'static_assert'.
---
 gcc/fortran/trans-stmt.cc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 94ecde096d5..37f8acaea3f 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -5154,7 +5154,7 @@ gfc_trans_concurrent_locality_spec (bool after_body, 
stmtblock_t *body,
   gfc_start_saved_local_decls ();
 
   cnt = 0;
-  static_assert (LOCALITY_LOCAL_INIT - LOCALITY_LOCAL == 1);
+  static_assert (LOCALITY_LOCAL_INIT - LOCALITY_LOCAL == 1, "locality_type");
   for (int type = LOCALITY_LOCAL;
type <= LOCALITY_LOCAL_INIT; type++)
 for (el = locality_list[type]; el; el = el->next)
-- 
2.34.1

Documentation for the REDUCE intrinsic

[Paul Richard Thomas]

Hi All,

Now that the reduce intrinsic seems to be OK on all platforms, I thought
that it was time to catch up with the documentation.

The attached produces good .html without any additional warnings or errors
using texi2any and ~/share/info/gfortran.info is as intended.

OK for mainline?

Paul
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 8c160e58b00..6fa6fc278be 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -270,6 +270,7 @@ Some basic guidelines for editing this document:
 * @code{RANGE}: RANGE, Decimal exponent range
 * @code{RANK} : RANK,  Rank of a data object
 * @code{REAL}:  REAL,  Convert to real type 
+* @code{REDUCE}:REDUCE,Reduction of an array with a user function
 * @code{RENAME}:RENAME,Rename a file
 * @code{REPEAT}:REPEAT,Repeated string concatenation
 * @code{RESHAPE}:   RESHAPE,   Function to reshape an array
@@ -12410,6 +12411,107 @@ integers}).
 
 
 
+@node REDUCE
+@section @code{REDUCE} --- Reduction of an array with a user function
+@fnindex REDUCE
+@cindex array, change dimensions
+@cindex array, transmogrify
+
+@table @asis
+@item @emph{Synopsis}:
+@code{RESULT = REDUCE (ARRAY, OPERATION [, MASK, IDENTITY, ORDERED])}
+or
+@code{RESULT = REDUCE (ARRAY, OPERATION, DIM [, MASK, IDENTITY, ORDERED])}
+
+@item @emph{Description}:
+Reduces @var{ARRAY} using the scalar function @var{OPERATION}. If DIM 
+is not present the result is a scalar. Otherwise, the reduction takes 
+place along the dimension @var{DIM} and the result has a rank one less 
+than that of @var{ARRAY}. @var{MASK} is a logical array with the same 
+shape as @var{ARRAY}. If any elements of the reduction are empty, they 
+are filled by @var{IDENTITY}. @var{ORDERED} has no effect at present.
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of any type.
+@item @var{OPERATION} @tab Shall be a pure function with exactly two 
+arguments; each argument shall be a scalar, nonallocatable, 
+noncoarray, nonpointer, nonpolymorphic, nonoptional dummy data object 
+with the same declared type and type parameters as @var{ARRAY}. If one 
+argument has the ASYNCHRONOUS, TARGET, or VALUE attribute, the other 
+shall have that attribute. Its result shall be a nonpolymorphic scalar 
+and have the same declared type and type parameters as @var{ARRAY}. 
+@var{OPERATION} should implement a mathematically associative 
+operation. It need not be commutative.
+@item @var{DIM} @tab Shall be an integer scalar with a value in the 
+range 1 ≤ @var{DIM} ≤ n, where n is the rank of @var{ARRAY}.
+@item @var{MASK} @tab (Optional) shall be of type logical and shall be 
+conformable with @var{ARRAY}.
+@item @var{IDENTITY} @tab (Optional) shall be scalar with the same 
+declared type and type parameters as @var{ARRAY}.
+@item @var{ORDERED} @tab (Optional) shall be a logical scalar.
+@end multitable
+
+
+@item @emph{Return value}:
+The result is of the same declared type and type parameters as 
+@var{ARRAY}. It is scalar if @var{DIM} does not appear; otherwise, the 
+result has rank n − 1 and shape [d1, d2, . . . , d@var{DIM}−1, 
+d@var{DIM}+1, . . . , dn] where [d1, d2, . . . , dn] is the shape of 
+@var{ARRAY}.
+
+Case (i): The result of @code{REDUCE (ARRAY, OPERATION [, IDENTITY = 
+IDENTITY, ORDERED = ORDERED])} over the sequence of values in 
+@var{ARRAY} is the result of an iterative process. The initial order 
+of the sequence is array element order. While the sequence has more 
+than one element, each iteration involves the execution of @code{r 
+= OPERATION(x, y)} for adjacent x and y in the sequence, with x 
+immediately preceding y, and the subsequent replacement of x and y 
+with r; if @var{ORDERED} is present with the value true, x and y shall 
+be the first two elements of the sequence. The process continues until 
+the sequence has only one element which is the value of the reduction. 
+If the initial sequence is empty, the result has the value 
+@var{IDENTITY} if @var{IDENTITY} is present, and otherwise, error 
+termination is initiated.
+
+Case (ii): The result of @code{REDUCE (ARRAY, OPERATION, MASK = MASK 
+[, IDENTITY = IDENTITY, ORDERED = ORDERED])} is as for Case (i) except 
+that the initial sequence is only those elements of @var{ARRAY} for 
+which the corresponding elements of @var{MASK} are true.
+
+Case (iii): If @var{ARRAY} has rank one, @code{REDUCE (ARRAY, 
+OPERATION, DIM = DIM [, MASK = MASK, IDENTITY = IDENTITY, ORDERED = 
+ORDERED])} has a value equal to that of @code{REDUCE (AR41 RAY, 
+OPERATION [, MASK = MASK, IDENTITY = IDENTITY, ORDERED = ORDERED])}. 
+Otherwise, the value of element (s1, s2, . . . , sDIM−1, sDIM+1, . . . 
+, sn) of @code{REDUCE (ARRAY, OPERATION, DIM = DIM [, MASK = MASK, 
+IDENTITY = IDENTITY, ORDERED = ORDERED])} is equal to @code{REDUCE 
+(ARRAY (s1, s2, . . . , 

[patch, libgfortran] PR119502

[Jerry D]

The attached patch fixes this bug by adding checks for negative unit 
numbers in CLOSE and OPEN statements.


Regression tested on x86_64_linux_gnu.

OK for trunk

Author: Jerry DeLisle 
Date:   Sat Apr 12 19:51:23 2025 -0700

Fortran: Fix runtime segfault closing negative unit

When closing a UNIT with an invalid negative unit
number, a segfault ensued. This patch adds checks
for these conditions and issues errors.

PR libfortran/119502

libgfortran/ChangeLog:

* io/close.c (st_close): Issue an error and avoid
calling close_share when there is no stream assigned.
* io/open.c (st_open): If there is no stream assigned
to the unit, unlock the unit and issue an error.

gcc/testsuite/ChangeLog:

* gfortran.dg/pr119502.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/pr119502.f90 b/gcc/testsuite/gfortran.dg/pr119502.f90
new file mode 100644
index 000..80d7c610165
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr119502.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+
+! PR119502, negative unit numbers are not allowed without using NEWUNIT
+
+program foo
+  integer :: iun = -1
+  integer :: ios
+  open (iun, iostat=ios)
+  if (ios == 0) stop 1
+  write(iun,*, iostat=ios) "This is a test."
+  if (ios == 0) stop 2
+  close (iun, iostat=ios)
+  if (ios == 0) stop 3
+end
+
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 81223113dc5..41d278c002c 100644
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -84,8 +84,17 @@ st_close (st_parameter_close *clp)
 
   if (u != NULL)
 {
-  if (close_share (u) < 0)
-	generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
+  if (u->s == NULL)
+	{
+	  if (u->unit_number < 0)
+	generate_error (&clp->common, LIBERROR_BAD_UNIT,
+			"Unit number is negative with no associated file");
+	  library_end ();
+	  return;
+	}
+  else
+	if (close_share (u) < 0)
+	  generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
   if (u->flags.status == STATUS_SCRATCH)
 	{
 	  if (status == CLOSE_KEEP)
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 06ddf7f4dc2..e9fb0a7b3b0 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -912,6 +912,16 @@ st_open (st_parameter_open *opp)
 	  library_end ();
 	  return;
 	}
+
+	  if (u->s == NULL)
+	{
+	  unlock_unit (u);
+	  generate_error (&opp->common, LIBERROR_BAD_OPTION,
+			"Unit number is negative and unit was not already "
+			"opened with OPEN(NEWUNIT=...)");
+	  library_end ();
+	  return;
+	}
 	}
 
   if (u == NULL)