This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
Hello world, this patch fixes PR 34671 by providing any, all and count intrinsics for kind=1 and kind=2 functions. It also uses GFC_LOGICAL_1 pointers to cut down on the number of functions needed, and converts the mask arguments to kind=1 to save memory if these are functions (like we already do with mask arguments to other intrinsics). If you apply this patch, make sure to at least delete your whole libgfortran build directory (or even better, build from scratch); otherwise, you'll get strange errors about missing functions. Right now regression-testing on i686-pc-linux-gnu. OK if this passes? Thomas
Index: gfortran.map
===================================================================
--- gfortran.map (revision 131492)
+++ gfortran.map (working copy)
@@ -8,10 +8,14 @@ GFORTRAN_1.0 {
_gfortran_alarm_sub_i8;
_gfortran_alarm_sub_int_i4;
_gfortran_alarm_sub_int_i8;
+ _gfortran_all_l1;
_gfortran_all_l16;
+ _gfortran_all_l2;
_gfortran_all_l4;
_gfortran_all_l8;
+ _gfortran_any_l1;
_gfortran_any_l16;
+ _gfortran_any_l2;
_gfortran_any_l4;
_gfortran_any_l8;
_gfortran_arandom_r10;
@@ -28,15 +32,11 @@ GFORTRAN_1.0 {
_gfortran_chmod_i8_sub;
_gfortran_compare_string;
_gfortran_concat_string;
- _gfortran_count_16_l16;
- _gfortran_count_16_l4;
- _gfortran_count_16_l8;
- _gfortran_count_4_l16;
- _gfortran_count_4_l4;
- _gfortran_count_4_l8;
- _gfortran_count_8_l16;
- _gfortran_count_8_l4;
- _gfortran_count_8_l8;
+ _gfortran_count_1_l;
+ _gfortran_count_16_l;
+ _gfortran_count_2_l;
+ _gfortran_count_4_l;
+ _gfortran_count_8_l;
_gfortran_cpu_time_10;
_gfortran_cpu_time_16;
_gfortran_cpu_time_4;
Index: Makefile.am
===================================================================
--- Makefile.am (revision 131492)
+++ Makefile.am (working copy)
@@ -121,25 +121,25 @@ runtime/string.c \
runtime/select.c
i_all_c= \
+$(srcdir)/generated/all_l1.c \
+$(srcdir)/generated/all_l2.c \
$(srcdir)/generated/all_l4.c \
$(srcdir)/generated/all_l8.c \
$(srcdir)/generated/all_l16.c
i_any_c= \
+$(srcdir)/generated/any_l1.c \
+$(srcdir)/generated/any_l2.c \
$(srcdir)/generated/any_l4.c \
$(srcdir)/generated/any_l8.c \
$(srcdir)/generated/any_l16.c
i_count_c= \
-$(srcdir)/generated/count_4_l4.c \
-$(srcdir)/generated/count_8_l4.c \
-$(srcdir)/generated/count_16_l4.c \
-$(srcdir)/generated/count_4_l8.c \
-$(srcdir)/generated/count_8_l8.c \
-$(srcdir)/generated/count_16_l8.c \
-$(srcdir)/generated/count_4_l16.c \
-$(srcdir)/generated/count_8_l16.c \
-$(srcdir)/generated/count_16_l16.c
+$(srcdir)/generated/count_1_l.c \
+$(srcdir)/generated/count_2_l.c \
+$(srcdir)/generated/count_4_l.c \
+$(srcdir)/generated/count_8_l.c \
+$(srcdir)/generated/count_16_l.c
i_maxloc0_c= \
$(srcdir)/generated/maxloc0_4_i1.c \
@@ -463,7 +463,7 @@ $(srcdir)/generated/pow_c16_i16.c
m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
- m4/matmul.m4 m4/matmull.m4 \
+ m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
@@ -684,6 +684,7 @@ endif
I_M4_DEPS=m4/iparm.m4
I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
+I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@@ -707,13 +708,13 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADE
## so we only include them in maintainer mode
if MAINTAINER_MODE
-$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
+$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
-$(i_any_c): m4/any.m4 $(I_M4_DEPS1)
+$(i_any_c): m4/any.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@
-$(i_count_c): m4/count.m4 $(I_M4_DEPS1)
+$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
Index: m4/all.m4
===================================================================
--- m4/all.m4 (revision 131492)
+++ m4/all.m4 (working copy)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(1,
` /* Return true only if all the elements are set. */
Index: m4/count.m4
===================================================================
--- m4/count.m4 (revision 131492)
+++ m4/count.m4 (working copy)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',
Index: m4/any.m4
===================================================================
--- m4/any.m4 (revision 131492)
+++ m4/any.m4 (working copy)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',
Attachment:
changelog
Description: Text document
! { dg-do run }
program main
character(len=*), parameter :: f='(3L1)'
character(len=*), parameter :: g='(3I1)'
real, dimension(3,3) :: a
logical(kind=1), dimension(3,3) :: m1
logical(kind=2), dimension(3,3) :: m2
logical(kind=4), dimension(3,3) :: m4
logical(kind=8), dimension(3,3) :: m8
character(len=3) :: res
data a /-1.0, -2.0, -3.0, 2.0, 1.0, -2.1, 1.0, 2.0, 3.0 /
m1 = a > 0
m2 = a > 0
m4 = a > 0
m8 = a > 0
write (unit=res,fmt=f) any(m1,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m2,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m4,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m8,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m1,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m2,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m4,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m8,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) all(m1,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m2,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m4,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m8,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m1,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m2,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m4,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m8,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=g) count(m1,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m2,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m4,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m8,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m1,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m2,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m4,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m8,dim=2)
if (res /= '221') call abort
end program main
Attachment:
ifunction_logical.m4
Description: application/m4
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |