This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC 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]

[patch, fortran] Fix PR 34671 - logical kind=1 and kind=2 intrinsics


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]