diff --git a/gcc-12.1.0.tar.gz b/gcc-12.1.0.tar.gz deleted file mode 100644 index 316de66254f8846138440ed7a2a5fe1a5b72268c..0000000000000000000000000000000000000000 Binary files a/gcc-12.1.0.tar.gz and /dev/null differ diff --git a/gcc-12.2.1.tar.gz b/gcc-12.2.1.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..9bf74167bd93d301503095ae4b57f7f9a518a49e Binary files /dev/null and b/gcc-12.2.1.tar.gz differ diff --git a/gcc.spec b/gcc.spec index e80e572ec2035c7ef74ac198def95987df330bf1..96d9bc0e530f7b5b05577e518a6ae7fcafc431ab 100644 --- a/gcc.spec +++ b/gcc.spec @@ -1,14 +1,12 @@ %define anolis_release 1 -%global DATE 20220506 -%global gitrev 7222fb983d798306a83666324a92fce5e5881eb7 -%global gcc_version 12.1.0 +%global DATE 20221121 +%global gitrev b3f5a0d53b84ed27cf00cfa2b9c3e2c78935c07d +%global gcc_version 12.2.1 %global gcc_major 12 -# Note, gcc_release must be integer, if you want to add suffixes to -# %%{release}, append them after %%{gcc_release} on Release: line. -%global gcc_release 0 -%global nvptx_tools_gitrev 5f6f343a302d620b0868edab376c00b15741e39e -%global newlib_cygwin_gitrev 50e2a63b04bdd018484605fbb954fd1bd5147fa0 +%global isl_version 0.24 +%global nvptx_tools_gitrev 472b6e78b3ba918d727698f79911360b7c808247 +%global newlib_cygwin_gitrev a8526cb52bedabd4d6ba4b227a5185627f871aa1 %global _unpackaged_files_terminate_build 0 %global _performance_build 1 # Hardening slows the compiler way too much. @@ -30,7 +28,10 @@ %ifarch x86_64 %global build_libquadmath 1 +%global build_offload_nvptx 1 +%global multilib_32_arch i686 %else +%global build_offload_nvptx 0 %global build_libquadmath 0 %endif %global build_libasan 1 @@ -39,17 +40,11 @@ %global build_libubsan 1 %global build_libatomic 1 %global build_libitm 1 -%global build_isl 1 +%global build_isl 0 %global build_libstdcxx_docs 1 %global attr_ifunc 1 -%ifarch x86_64 -%global build_offload_nvptx 1 -%else -%global build_offload_nvptx 0 -%endif -%ifarch x86_64 -%global multilib_32_arch i686 -%endif +%global build_annobin_plugin 1 + Summary: Various compilers (C, C++, Objective-C, ...) Name: gcc Version: %{gcc_version} @@ -72,7 +67,6 @@ Source1: nvptx-tools-%{nvptx_tools_gitrev}.tar.xz # git --git-dir=newlib-cygwin-dir.tmp/.git archive --prefix=newlib-cygwin-%%{newlib_cygwin_gitrev}/ %%{newlib_cygwin_gitrev} ":(exclude)newlib/libc/sys/linux/include/rpc/*.[hx]" | xz -9e > newlib-cygwin-%%{newlib_cygwin_gitrev}.tar.xz # rm -rf newlib-cygwin-dir.tmp Source2: newlib-cygwin-%{newlib_cygwin_gitrev}.tar.xz -%global isl_version 0.18 Source3: https://gcc.gnu.org/pub/gcc/infrastructure/isl-%{isl_version}.tar.bz2 URL: http://gcc.gnu.org BuildRequires: binutils >= 2.31 @@ -141,19 +135,13 @@ Patch5: gcc12-no-add-needed.patch Patch6: gcc12-Wno-format-security.patch Patch7: gcc12-rh1574936.patch Patch8: gcc12-d-shared-libphobos.patch -Patch9: gcc12-ifcvt-revert.patch +Patch9: gcc12-pr107468.patch # patches for fortran Patch100: gcc12-fortran-fdec-duplicates.patch Patch101: gcc12-fortran-flogical-as-integer.patch -Patch102: gcc12-fortran-fdec-ichar.patch -Patch103: gcc12-fortran-fdec-non-integer-index.patch -Patch104: gcc12-fortran-fdec-old-init.patch -Patch105: gcc12-fortran-fdec-override-kind.patch -Patch106: gcc12-fortran-fdec-non-logical-if.patch -Patch107: gcc12-fortran-fdec-promotion.patch -Patch108: gcc12-fortran-fdec-sequence.patch -Patch109: gcc12-fortran-fdec-add-missing-indexes.patch +Patch102: gcc12-fortran-fdec-override-kind.patch +Patch103: gcc12-fortran-fdec-non-logical-if.patch %global _gnu %{nil} @@ -628,6 +616,27 @@ NVidia PTX. OpenMP and OpenACC programs linked with -fopenmp will by default add PTX code into the binaries, which can be offloaded to NVidia PTX capable devices if available. +%if %{build_annobin_plugin} +%package plugin-annobin +Summary: The annobin plugin for gcc, built by the installed version of gcc +Requires: gcc = %{version}-%{release} +BuildRequires: annobin-plugin-gcc >= 10.62, rpm-devel, binutils-devel, xz +BuildRequires: gcc-plugin-devel + +%description plugin-annobin +This package adds a version of the annobin plugin for gcc. This version +of the plugin is explicitly built by the same version of gcc that is installed +so that there cannot be any synchronization problems. +%endif + +%package doc +Summary: Documentation files for %{name} +Requires: %{name} = %{version}-%{release} +BuildArch: noarch + +%description doc +The %{name}-doc package contains documentation files for %{name}. + %prep %setup -q -n gcc-releases-gcc-%{version} -a 1 -a 2 -a 3 %patch0 -p0 -b .hack~ @@ -643,23 +652,17 @@ to NVidia PTX capable devices if available. %patch6 -p0 -b .Wno-format-security~ %patch7 -p0 -b .rh1574936~ %patch8 -p0 -b .d-shared-libphobos~ -%patch9 -p0 -b .ifcvt-revert~ +%patch9 -p0 -b .pr106590~ %patch100 -p1 -b .fortran-fdec-duplicates~ %patch101 -p1 -b .fortran-flogical-as-integer~ -%patch102 -p1 -b .fortran-fdec-ichar~ -%patch103 -p1 -b .fortran-fdec-non-integer-index~ -%patch104 -p1 -b .fortran-fdec-old-init~ -%patch105 -p1 -b .fortran-fdec-override-kind~ -%patch106 -p1 -b .fortran-fdec-non-logical-if~ -%patch107 -p1 -b .fortran-fdec-promotion~ -%patch108 -p1 -b .fortran-fdec-sequence~ -%patch109 -p1 -b .fortran-fdec-add-missing-indexes~ +%patch102 -p1 -b .fortran-fdec-override-kind~ +%patch103 -p1 -b .fortran-fdec-non-logical-if~ rm -f libphobos/testsuite/libphobos.gc/forkgc2.d #rm -rf libphobos/testsuite/libphobos.gc -echo 'Anolis OS %{version}-%{gcc_release}' > gcc/DEV-PHASE +echo 'Anolis OS %{version}-%{anolis_release}' > gcc/DEV-PHASE cp -a libstdc++-v3/config/cpu/i{4,3}86/atomicity.h @@ -907,6 +910,26 @@ done) rm -f rpm.doc/changelogs/gcc/ChangeLog.[1-9] find rpm.doc -name \*ChangeLog\* | xargs bzip2 -9 +%if %{build_annobin_plugin} +mkdir annobin-plugin +cd annobin-plugin +tar xf %{_usrsrc}/annobin/latest-annobin.tar.xz +cd annobin* +touch aclocal.m4 configure Makefile.in */configure */config.h.in */Makefile.in +ANNOBIN_FLAGS=../../obj-%{gcc_target_platform}/%{gcc_target_platform}/libstdc++-v3/scripts/testsuite_flags +ANNOBIN_CFLAGS1="%build_cflags -I %{_builddir}/gcc-%{version}-%{DATE}/gcc" +ANNOBIN_CFLAGS1="$ANNOBIN_CFLAGS1 -I %{_builddir}/gcc-%{version}-%{DATE}/obj-%{gcc_target_platform}/gcc" +ANNOBIN_CFLAGS2="-I %{_builddir}/gcc-%{version}-%{DATE}/include -I %{_builddir}/gcc-%{version}-%{DATE}/libcpp/include" +ANNOBIN_LDFLAGS="%build_ldflags -L%{_builddir}/gcc-%{version}-%{DATE}/obj-%{gcc_target_platform}/%{gcc_target_platform}/libstdc++-v3/src/.libs" +CC="`$ANNOBIN_FLAGS --build-cc`" CXX="`$ANNOBIN_FLAGS --build-cxx`" \ + CFLAGS="$ANNOBIN_CFLAGS1 $ANNOBIN_CFLAGS2 $ANNOBIN_LDFLAGS" \ + CXXFLAGS="$ANNOBIN_CFLAGS1 `$ANNOBIN_FLAGS --build-includes` $ANNOBIN_CFLAGS2 $ANNOBIN_LDFLAGS" \ + ./configure --with-gcc-plugin-dir=%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin \ + --without-annocheck --without-tests --without-docs --disable-rpath --without-debuginfod +make +cd ../.. +%endif + %install rm -rf %{buildroot} mkdir -p %{buildroot} @@ -1499,12 +1522,22 @@ echo gcc-%{version}-%{release}.%{_arch} > $FULLPATH/rpmver ln -s ../../libexec/gcc/%{gcc_target_platform}/%{gcc_major}/liblto_plugin.so \ %{buildroot}%{_libdir}/bfd-plugins/ +%if %{build_annobin_plugin} +mkdir -p $FULLPATH/plugin +rm -f $FULLPATH/plugin/gcc-annobin* +cp -a %{_builddir}/gcc-releases-gcc-%{version}/annobin-plugin/annobin*/gcc-plugin/.libs/annobin.so.0.0.0 \ + $FULLPATH/plugin/gcc-annobin.so.0.0.0 +ln -sf gcc-annobin.so.0.0.0 $FULLPATH/plugin/gcc-annobin.so.0 +ln -sf gcc-annobin.so.0.0.0 $FULLPATH/plugin/gcc-annobin.so +%endif + %check cd obj-%{gcc_target_platform} # run the tests. LC_ALL=C make %{?_smp_mflags} -k check ALT_CC_UNDER_TEST=gcc ALT_CXX_UNDER_TEST=g++ \ RUNTESTFLAGS="--target_board=unix/'{,-fstack-protector-strong}'" || : +%if !%{build_annobin_plugin} if [ -f %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/annobin.so ]; then # Test whether current annobin plugin won't fail miserably with the newly built gcc. echo -e '#include \nint main () { printf ("Hello, world!\\n"); return 0; }' > annobin-test.c @@ -1535,9 +1568,12 @@ if [ -f %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/annobin.so cat ANNOBINOUT ANNOBINRES[12] >> ANNOBINRES rm -f ANNOBINOUT* ANNOBINRES[12] annobin-test{c,C} fi +%endif echo ====================TESTING========================= ( LC_ALL=C ../contrib/test_summary || : ) 2>&1 | sed -n '/^cat.*EOF/,/^EOF/{/^cat.*EOF/d;/^EOF/d;/^LAST_UPDATED:/d;p;}' +%if !%{build_annobin_plugin} [ -f ANNOBINRES ] && cat ANNOBINRES +%endif echo ====================TESTING END===================== mkdir testlogs-%{_target_platform}-%{version}-%{release} for i in `find . -name \*.log | grep -F testsuite/ | grep -v 'config.log\|acats.*/tests/'`; do @@ -1839,8 +1875,6 @@ end %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/liblsan_preinit.o %endif %{_prefix}/libexec/getconf/default -%doc gcc/README* rpm.doc/changelogs/gcc/ChangeLog* -%{!?_licensedir:%global license %%doc} %license gcc/COPYING* COPYING.RUNTIME %files -n cpp -f cpplib.lang @@ -1856,7 +1890,6 @@ end %files -n libgcc /%{_lib}/libgcc_s-%{gcc_major}-%{DATE}.so.1 /%{_lib}/libgcc_s.so.1 -%{!?_licensedir:%global license %%doc} %license gcc/COPYING* COPYING.RUNTIME %files c++ @@ -1883,7 +1916,6 @@ end %ifarch %{multilib_64_archs} %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libstdc++.so %endif -%doc rpm.doc/changelogs/gcc/cp/ChangeLog* %files -n libstdc++ %{_prefix}/%{_lib}/libstdc++.so.6* @@ -1908,7 +1940,6 @@ end %endif %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libstdc++fs.a %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libstdc++_libbacktrace.a -%doc rpm.doc/changelogs/libstdc++-v3/ChangeLog* libstdc++-v3/README* %files -n libstdc++-static %dir %{_prefix}/lib/gcc @@ -1942,7 +1973,6 @@ end %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libobjc.so %endif %doc rpm.doc/objc/* -%doc libobjc/THREADS* rpm.doc/changelogs/libobjc/ChangeLog* %files objc++ %dir %{_prefix}/libexec/gcc @@ -2060,7 +2090,6 @@ end %endif %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/ada_target_properties %{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/gnat1 -%doc rpm.doc/changelogs/gcc/ada/ChangeLog* %files -n libgnat %{_prefix}/%{_lib}/libgnat-*.so @@ -2087,13 +2116,11 @@ end %files -n libgomp %{_prefix}/%{_lib}/libgomp.so.1* %{_infodir}/libgomp.info* -%doc rpm.doc/changelogs/libgomp/ChangeLog* %if %{build_libquadmath} %files -n libquadmath %{_prefix}/%{_lib}/libquadmath.so.0* %{_infodir}/libquadmath.info* -%{!?_licensedir:%global license %%doc} %license rpm.doc/libquadmath/COPYING* %files -n libquadmath-devel @@ -2154,8 +2181,6 @@ end %dir %{_prefix}/lib/gcc/%{gcc_target_platform} %dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libasan.a -%doc rpm.doc/changelogs/libsanitizer/ChangeLog* -%{!?_licensedir:%global license %%doc} %license libsanitizer/LICENSE.TXT %endif @@ -2168,8 +2193,6 @@ end %dir %{_prefix}/lib/gcc/%{gcc_target_platform} %dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libubsan.a -%doc rpm.doc/changelogs/libsanitizer/ChangeLog* -%{!?_licensedir:%global license %%doc} %license libsanitizer/LICENSE.TXT %endif @@ -2182,8 +2205,6 @@ end %dir %{_prefix}/lib/gcc/%{gcc_target_platform} %dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libtsan.a -%doc rpm.doc/changelogs/libsanitizer/ChangeLog* -%{!?_licensedir:%global license %%doc} %license libsanitizer/LICENSE.TXT %endif @@ -2196,8 +2217,6 @@ end %dir %{_prefix}/lib/gcc/%{gcc_target_platform} %dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/liblsan.a -%doc rpm.doc/changelogs/libsanitizer/ChangeLog* -%{!?_licensedir:%global license %%doc} %license libsanitizer/LICENSE.TXT %endif @@ -2263,7 +2282,6 @@ end %files -n libgccjit %{_prefix}/%{_lib}/libgccjit.so.* -%doc rpm.doc/changelogs/gcc/jit/ChangeLog* %files -n libgccjit-devel %{_prefix}/%{_lib}/libgccjit.so @@ -2292,7 +2310,6 @@ end %dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/libcc1plugin.so* %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/libcp1plugin.so* -%doc rpm.doc/changelogs/libcc1/ChangeLog* %if %{build_offload_nvptx} %files offload-nvptx @@ -2318,7 +2335,36 @@ end %{_prefix}/%{_lib}/libgomp-plugin-nvptx.so.* %endif +%if %{build_annobin_plugin} +%files plugin-annobin +%dir %{_prefix}/lib/gcc +%dir %{_prefix}/lib/gcc/%{gcc_target_platform} +%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} +%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin +%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/gcc-annobin.so +%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/gcc-annobin.so.0 +%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/gcc-annobin.so.0.0.0 +%endif + +%files doc +%doc ABOUT-NLS README MAINTAINERS ChangeLog* +%doc gcc/README* rpm.doc/changelogs/gcc/ChangeLog* +%doc rpm.doc/changelogs/gcc/cp/ChangeLog* +%doc rpm.doc/changelogs/libcc1/ChangeLog* +%doc rpm.doc/changelogs/gcc/jit/ChangeLog* +%doc rpm.doc/changelogs/libsanitizer/ChangeLog* +%doc rpm.doc/changelogs/libstdc++-v3/ChangeLog* libstdc++-v3/README* +%doc libobjc/THREADS* rpm.doc/changelogs/libobjc/ChangeLog* +%doc rpm.doc/changelogs/libsanitizer/ChangeLog* +%doc rpm.doc/changelogs/libgomp/ChangeLog* +%doc rpm.doc/changelogs/gcc/ada/ChangeLog* +%doc rpm.doc/changelogs/libsanitizer/ChangeLog* + + %changelog +* Tue Jan 03 2023 happy_orange - 12.2.1-1 +- update to 12.2.1 + * Sat May 7 2022 Chunmei Xu - 12.1.0-1 - update to release 12.1 diff --git a/gcc12-fortran-fdec-add-missing-indexes.patch b/gcc12-fortran-fdec-add-missing-indexes.patch deleted file mode 100644 index 529868f5f9678652f592885ae9c564a35f74f308..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-add-missing-indexes.patch +++ /dev/null @@ -1,181 +0,0 @@ -From 7001d522d0273658d9e1fb12ca104d56bfcae34d Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 15:06:08 +0000 -Subject: [PATCH 10/10] Fill in missing array dimensions using the lower bound - -Use -fdec-add-missing-indexes to enable feature. Also enabled by fdec. ---- - gcc/fortran/lang.opt | 8 ++++++++ - gcc/fortran/options.cc | 1 + - gcc/fortran/resolve.cc | 24 ++++++++++++++++++++++++ - gcc/testsuite/gfortran.dg/array_6.f90 | 23 +++++++++++++++++++++++ - gcc/testsuite/gfortran.dg/array_7.f90 | 23 +++++++++++++++++++++++ - gcc/testsuite/gfortran.dg/array_8.f90 | 23 +++++++++++++++++++++++ - 6 files changed, 102 insertions(+) - create mode 100644 gcc/testsuite/gfortran.dg/array_6.f90 - create mode 100644 gcc/testsuite/gfortran.dg/array_7.f90 - create mode 100644 gcc/testsuite/gfortran.dg/array_8.f90 - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index 019c798cf09..f27de88ea3f 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -281,6 +281,10 @@ Wmissing-include-dirs - Fortran - ; Documented in C/C++ - -+Wmissing-index -+Fortran Var(warn_missing_index) Warning LangEnabledBy(Fortran,Wall) -+Warn that the lower bound of a missing index will be used. -+ - Wuse-without-only - Fortran Var(warn_use_without_only) Warning - Warn about USE statements that have no ONLY qualifier. -@@ -460,6 +464,10 @@ fdec - Fortran Var(flag_dec) - Enable all DEC language extensions. - -+fdec-add-missing-indexes -+Fortran Var(flag_dec_add_missing_indexes) -+Enable the addition of missing indexes using their lower bounds. -+ - fdec-blank-format-item - Fortran Var(flag_dec_blank_format_item) - Enable the use of blank format items in format strings. -diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc -index 050f56fdc25..c3b2822685d 100644 ---- a/gcc/fortran/options.cc -+++ b/gcc/fortran/options.cc -@@ -84,6 +84,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_non_logical_if, value, value); - SET_BITFLAG (flag_dec_promotion, value, value); - SET_BITFLAG (flag_dec_sequence, value, value); -+ SET_BITFLAG (flag_dec_add_missing_indexes, value, value); - } - - /* Finalize DEC flags. */ -diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc -index fe7d0cc5944..0efeedab46e 100644 ---- a/gcc/fortran/resolve.cc -+++ b/gcc/fortran/resolve.cc -@@ -4806,6 +4806,30 @@ compare_spec_to_ref (gfc_array_ref *ar) - if (ar->type == AR_FULL) - return true; - -+ if (flag_dec_add_missing_indexes && as->rank > ar->dimen) -+ { -+ /* Add in the missing dimensions, assuming they are the lower bound -+ of that dimension if not specified. */ -+ int j; -+ if (warn_missing_index) -+ { -+ gfc_warning (OPT_Wmissing_index, "Using the lower bound for " -+ "unspecified dimensions in array reference at %L", -+ &ar->where); -+ } -+ /* Other parts of the code iterate ar->start and ar->end from 0 to -+ ar->dimen, so it is safe to assume slots from ar->dimen upwards -+ are unused (i.e. there are no gaps; the specified indexes are -+ contiguous and start at zero. */ -+ for(j = ar->dimen; j <= as->rank; j++) -+ { -+ ar->start[j] = gfc_copy_expr (as->lower[j]); -+ ar->end[j] = gfc_copy_expr (as->lower[j]); -+ ar->dimen_type[j] = DIMEN_ELEMENT; -+ } -+ ar->dimen = as->rank; -+ } -+ - if (as->rank != ar->dimen) - { - gfc_error ("Rank mismatch in array reference at %L (%d/%d)", -diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90 -new file mode 100644 -index 00000000000..5c26e18ab3e ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/array_6.f90 -@@ -0,0 +1,23 @@ -+! { dg-do run } -+! { dg-options "-fdec -Wmissing-index" }! -+! Checks that under-specified arrays (referencing arrays with fewer -+! dimensions than the array spec) generates a warning. -+! -+! Contributed by Jim MacArthur -+! Updated by Mark Eggleston -+! -+ -+program under_specified_array -+ integer chessboard(8,8) -+ integer chessboard3d(8,8,3:5) -+ chessboard(3,1) = 5 -+ chessboard(3,2) = 55 -+ chessboard3d(4,1,3) = 6 -+ chessboard3d(4,1,4) = 66 -+ chessboard3d(4,4,3) = 7 -+ chessboard3d(4,4,4) = 77 -+ -+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+end program -diff --git a/gcc/testsuite/gfortran.dg/array_7.f90 b/gcc/testsuite/gfortran.dg/array_7.f90 -new file mode 100644 -index 00000000000..5588a5bd02d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/array_7.f90 -@@ -0,0 +1,23 @@ -+! { dg-do run } -+! { dg-options "-fdec-add-missing-indexes -Wmissing-index" }! -+! Checks that under-specified arrays (referencing arrays with fewer -+! dimensions than the array spec) generates a warning. -+! -+! Contributed by Jim MacArthur -+! Updated by Mark Eggleston -+! -+ -+program under_specified_array -+ integer chessboard(8,8) -+ integer chessboard3d(8,8,3:5) -+ chessboard(3,1) = 5 -+ chessboard(3,2) = 55 -+ chessboard3d(4,1,3) = 6 -+ chessboard3d(4,1,4) = 66 -+ chessboard3d(4,4,3) = 7 -+ chessboard3d(4,4,4) = 77 -+ -+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+end program -diff --git a/gcc/testsuite/gfortran.dg/array_8.f90 b/gcc/testsuite/gfortran.dg/array_8.f90 -new file mode 100644 -index 00000000000..f0d2ef5e37d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/array_8.f90 -@@ -0,0 +1,23 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-add-missing-indexes" }! -+! Checks that under-specified arrays (referencing arrays with fewer -+! dimensions than the array spec) generates a warning. -+! -+! Contributed by Jim MacArthur -+! Updated by Mark Eggleston -+! -+ -+program under_specified_array -+ integer chessboard(8,8) -+ integer chessboard3d(8,8,3:5) -+ chessboard(3,1) = 5 -+ chessboard(3,2) = 55 -+ chessboard3d(4,1,3) = 6 -+ chessboard3d(4,1,4) = 66 -+ chessboard3d(4,4,3) = 7 -+ chessboard3d(4,4,4) = 77 -+ -+ if (chessboard(3).ne.5) stop 1 ! { dg-error "Rank mismatch" } -+ if (chessboard3d(4).ne.6) stop 2 ! { dg-error "Rank mismatch" } -+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-error "Rank mismatch" } -+end program --- -2.27.0 - diff --git a/gcc12-fortran-fdec-ichar.patch b/gcc12-fortran-fdec-ichar.patch deleted file mode 100644 index 900b054ee1670d07d5fccdd68db3d0dd4d167acc..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-ichar.patch +++ /dev/null @@ -1,78 +0,0 @@ -From f883ac209b0feea860354cb4ef7ff06dc8063fab Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 12:53:35 +0000 -Subject: [PATCH 03/10] Allow more than one character as argument to ICHAR - -Use -fdec to enable. ---- - gcc/fortran/check.cc | 2 +- - gcc/fortran/simplify.cc | 4 ++-- - .../gfortran.dg/dec_ichar_with_string_1.f | 21 +++++++++++++++++++ - 3 files changed, 24 insertions(+), 3 deletions(-) - create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f - -diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc -index 82db8e4e1b2..623c1cc470e 100644 ---- a/gcc/fortran/check.cc -+++ b/gcc/fortran/check.cc -@@ -3157,7 +3157,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) - else - return true; - -- if (i != 1) -+ if (i != 1 && !flag_dec) - { - gfc_error ("Argument of %s at %L must be of length one", - gfc_current_intrinsic, &c->where); -diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc -index 23317a2e2d9..9900572424f 100644 ---- a/gcc/fortran/simplify.cc -+++ b/gcc/fortran/simplify.cc -@@ -3261,7 +3261,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) - if (e->expr_type != EXPR_CONSTANT) - return NULL; - -- if (e->value.character.length != 1) -+ if (e->value.character.length != 1 && !flag_dec) - { - gfc_error ("Argument of IACHAR at %L must be of length one", &e->where); - return &gfc_bad_expr; -@@ -3459,7 +3459,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind) - if (e->expr_type != EXPR_CONSTANT) - return NULL; - -- if (e->value.character.length != 1) -+ if (e->value.character.length != 1 && !flag_dec) - { - gfc_error ("Argument of ICHAR at %L must be of length one", &e->where); - return &gfc_bad_expr; -diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f -new file mode 100644 -index 00000000000..85efccecc0f ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f -@@ -0,0 +1,21 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! Test ICHAR and IACHAR with more than one character as argument -+! -+! Test case contributed by Jim MacArthur -+! Modified by Mark Eggleston -+! -+ PROGRAM ichar_more_than_one_character -+ CHARACTER*4 st/'Test'/ -+ INTEGER i -+ -+ i = ICHAR(st) -+ if (i.NE.84) STOP 1 -+ i = IACHAR(st) -+ if (i.NE.84) STOP 2 -+ i = ICHAR('Test') -+ if (i.NE.84) STOP 3 -+ i = IACHAR('Test') -+ if (i.NE.84) STOP 4 -+ END --- -2.27.0 - diff --git a/gcc12-fortran-fdec-non-integer-index.patch b/gcc12-fortran-fdec-non-integer-index.patch deleted file mode 100644 index 2c168fe926b3b61b680f55e65736e969fdf95217..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-non-integer-index.patch +++ /dev/null @@ -1,158 +0,0 @@ -From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 13:09:54 +0000 -Subject: [PATCH 04/10] Allow non-integer substring indexes - -Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec. ---- - gcc/fortran/lang.opt | 4 ++++ - gcc/fortran/options.cc | 1 + - gcc/fortran/resolve.cc | 20 +++++++++++++++++++ - .../dec_not_integer_substring_indexes_1.f | 18 +++++++++++++++++ - .../dec_not_integer_substring_indexes_2.f | 18 +++++++++++++++++ - .../dec_not_integer_substring_indexes_3.f | 18 +++++++++++++++++ - 6 files changed, 79 insertions(+) - create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index c4da248f07c..d527c106bd6 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -489,6 +489,10 @@ fdec-math - Fortran Var(flag_dec_math) - Enable legacy math intrinsics for compatibility. - -+fdec-non-integer-index -+Fortran Var(flag_dec_non_integer_index) -+Enable support for non-integer substring indexes. -+ - fdec-structure - Fortran Var(flag_dec_structure) - Enable support for DEC STRUCTURE/RECORD. -diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc -index f19ba87f8a0..9a042f64881 100644 ---- a/gcc/fortran/options.cc -+++ b/gcc/fortran/options.cc -@@ -78,6 +78,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_blank_format_item, value, value); - SET_BITFLAG (flag_dec_char_conversions, value, value); - SET_BITFLAG (flag_dec_duplicates, value, value); -+ SET_BITFLAG (flag_dec_non_integer_index, value, value); - } - - /* Finalize DEC flags. */ -diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc -index 4b90cb59902..bc0df0fdb99 100644 ---- a/gcc/fortran/resolve.cc -+++ b/gcc/fortran/resolve.cc -@@ -5131,6 +5131,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length) - if (!gfc_resolve_expr (ref->u.ss.start)) - return false; - -+ /* In legacy mode, allow non-integer string indexes by converting */ -+ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER -+ && gfc_numeric_ts (&ref->u.ss.start->ts)) -+ { -+ gfc_typespec t; -+ t.type = BT_INTEGER; -+ t.kind = ref->u.ss.start->ts.kind; -+ gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1); -+ } -+ - if (ref->u.ss.start->ts.type != BT_INTEGER) - { - gfc_error ("Substring start index at %L must be of type INTEGER", -@@ -5160,6 +5170,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length) - if (!gfc_resolve_expr (ref->u.ss.end)) - return false; - -+ /* Non-integer string index endings, as for start */ -+ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER -+ && gfc_numeric_ts (&ref->u.ss.end->ts)) -+ { -+ gfc_typespec t; -+ t.type = BT_INTEGER; -+ t.kind = ref->u.ss.end->ts.kind; -+ gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1); -+ } -+ - if (ref->u.ss.end->ts.type != BT_INTEGER) - { - gfc_error ("Substring end index at %L must be of type INTEGER", -diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f -new file mode 100644 -index 00000000000..0be28abaa4b ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f -@@ -0,0 +1,18 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! Test not integer substring indexes -+! -+! Test case contributed by Mark Eggleston -+! -+ PROGRAM not_integer_substring_indexes -+ CHARACTER*5 st/'Tests'/ -+ REAL ir/1.0/ -+ REAL ir2/4.0/ -+ -+ if (st(ir:4).ne.'Test') stop 1 -+ if (st(1:ir2).ne.'Test') stop 2 -+ if (st(1.0:4).ne.'Test') stop 3 -+ if (st(1:4.0).ne.'Test') stop 4 -+ if (st(2.5:4).ne.'est') stop 5 -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f -new file mode 100644 -index 00000000000..3cf05296d0c ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f -@@ -0,0 +1,18 @@ -+! { dg-do run } -+! { dg-options "-fdec-non-integer-index" } -+! -+! Test not integer substring indexes -+! -+! Test case contributed by Mark Eggleston -+! -+ PROGRAM not_integer_substring_indexes -+ CHARACTER*5 st/'Tests'/ -+ REAL ir/1.0/ -+ REAL ir2/4.0/ -+ -+ if (st(ir:4).ne.'Test') stop 1 -+ if (st(1:ir2).ne.'Test') stop 2 -+ if (st(1.0:4).ne.'Test') stop 3 -+ if (st(1:4.0).ne.'Test') stop 4 -+ if (st(2.5:4).ne.'est') stop 5 -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f -new file mode 100644 -index 00000000000..703de995897 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-non-integer-index" } -+! -+! Test not integer substring indexes -+! -+! Test case contributed by Mark Eggleston -+! -+ PROGRAM not_integer_substring_indexes -+ CHARACTER*5 st/'Tests'/ -+ REAL ir/1.0/ -+ REAL ir2/4.0/ -+ -+ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" } -+ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" } -+ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" } -+ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" } -+ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" } -+ END --- -2.27.0 - diff --git a/gcc12-fortran-fdec-non-logical-if.patch b/gcc12-fortran-fdec-non-logical-if.patch index 24a8fa492a0744678a2b2e8bf0b4835657a90e02..a3a830c363b824c89ea4831e2f736084eb0ab949 100644 --- a/gcc12-fortran-fdec-non-logical-if.patch +++ b/gcc12-fortran-fdec-non-logical-if.patch @@ -26,7 +26,7 @@ diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 4a269ebb22d..d886c2f33ed 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt -@@ -497,6 +497,10 @@ fdec-override-kind +@@ -506,6 +506,10 @@ fdec-override-kind Fortran Var(flag_dec_override_kind) Enable support for per variable kind specification. @@ -34,16 +34,16 @@ index 4a269ebb22d..d886c2f33ed 100644 +Fortran Var(flag_dec_non_logical_if) +Enable support for non-logical expressions in if statements. + - fdec-old-init - Fortran Var(flag_dec_old_init) - Enable support for old style initializers in derived types. + fdec-structure + Fortran Var(flag_dec_structure) + Enable support for DEC STRUCTURE/RECORD. diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc index edbab483b36..a946c86790a 100644 --- a/gcc/fortran/options.cc +++ b/gcc/fortran/options.cc -@@ -81,6 +81,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_non_integer_index, value, value); - SET_BITFLAG (flag_dec_old_init, value, value); +@@ -79,6 +79,7 @@ set_dec_flags (int value) + SET_BITFLAG (flag_dec_char_conversions, value, value); + SET_BITFLAG (flag_dec_duplicates, value, value); SET_BITFLAG (flag_dec_override_kind, value, value); + SET_BITFLAG (flag_dec_non_logical_if, value, value); } diff --git a/gcc12-fortran-fdec-old-init.patch b/gcc12-fortran-fdec-old-init.patch deleted file mode 100644 index d5661c870c84dbbc83bb41715f0accd5a78e3d45..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-old-init.patch +++ /dev/null @@ -1,185 +0,0 @@ -From 8bcc0f85ed1718c0dd9033ad4a34df181aabaffe Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 13:11:06 +0000 -Subject: [PATCH 05/10] Allow old-style initializers in derived types - -This allows simple declarations in derived types and structures, such as: - LOGICAL*1 NIL /0/ -Only single value expressions are allowed at the moment. - -Use -fdec-old-init to enable. Also enabled by -fdec. ---- - gcc/fortran/decl.cc | 27 +++++++++++++++---- - gcc/fortran/lang.opt | 4 +++ - gcc/fortran/options.cc | 1 + - ...ec_derived_types_initialised_old_style_1.f | 25 +++++++++++++++++ - ...ec_derived_types_initialised_old_style_2.f | 25 +++++++++++++++++ - ...ec_derived_types_initialised_old_style_3.f | 26 ++++++++++++++++++ - 6 files changed, 103 insertions(+), 5 deletions(-) - create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f - -diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc -index 723915822f3..5c8c1b7981b 100644 ---- a/gcc/fortran/decl.cc -+++ b/gcc/fortran/decl.cc -@@ -2827,12 +2827,29 @@ variable_decl (int elem) - but not components of derived types. */ - else if (gfc_current_state () == COMP_DERIVED) - { -- gfc_error ("Invalid old style initialization for derived type " -- "component at %C"); -- m = MATCH_ERROR; -- goto cleanup; -+ if (flag_dec_old_init) -+ { -+ /* Attempt to match an old-style initializer which is a simple -+ integer or character expression; this will not work with -+ multiple values. */ -+ m = gfc_match_init_expr (&initializer); -+ if (m == MATCH_ERROR) -+ goto cleanup; -+ else if (m == MATCH_YES) -+ { -+ m = gfc_match ("/"); -+ if (m != MATCH_YES) -+ goto cleanup; -+ } -+ } -+ else -+ { -+ gfc_error ("Invalid old style initialization for derived type " -+ "component at %C"); -+ m = MATCH_ERROR; -+ goto cleanup; -+ } - } -- - /* For structure components, read the initializer as a special - expression and let the rest of this function apply the initializer - as usual. */ -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index d527c106bd6..25cc948699b 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -493,6 +493,10 @@ fdec-non-integer-index - Fortran Var(flag_dec_non_integer_index) - Enable support for non-integer substring indexes. - -+fdec-old-init -+Fortran Var(flag_dec_old_init) -+Enable support for old style initializers in derived types. -+ - fdec-structure - Fortran Var(flag_dec_structure) - Enable support for DEC STRUCTURE/RECORD. -diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc -index 9a042f64881..d6bd36c3a8a 100644 ---- a/gcc/fortran/options.cc -+++ b/gcc/fortran/options.cc -@@ -79,6 +79,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_char_conversions, value, value); - SET_BITFLAG (flag_dec_duplicates, value, value); - SET_BITFLAG (flag_dec_non_integer_index, value, value); -+ SET_BITFLAG (flag_dec_old_init, value, value); - } - - /* Finalize DEC flags. */ -diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f -new file mode 100644 -index 00000000000..eac4f9bfcf1 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f -@@ -0,0 +1,25 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! Test old style initializers in derived types -+! -+! Contributed by Jim MacArthur -+! Modified by Mark Eggleston -+! -+ PROGRAM spec_in_var -+ TYPE STRUCT1 -+ INTEGER*4 ID /8/ -+ INTEGER*4 TYPE /5/ -+ INTEGER*8 DEFVAL /0/ -+ CHARACTER*(5) NAME /'tests'/ -+ LOGICAL*1 NIL /0/ -+ END TYPE STRUCT1 -+ -+ TYPE (STRUCT1) SINST -+ -+ IF(SINST%ID.NE.8) STOP 1 -+ IF(SINST%TYPE.NE.5) STOP 2 -+ IF(SINST%DEFVAL.NE.0) STOP 3 -+ IF(SINST%NAME.NE.'tests') STOP 4 -+ IF(SINST%NIL) STOP 5 -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f -new file mode 100644 -index 00000000000..d904c8b2974 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f -@@ -0,0 +1,25 @@ -+! { dg-do run } -+! { dg-options "-std=legacy -fdec-old-init" } -+! -+! Test old style initializers in derived types -+! -+! Contributed by Jim MacArthur -+! Modified by Mark Eggleston -+! -+ PROGRAM spec_in_var -+ TYPE STRUCT1 -+ INTEGER*4 ID /8/ -+ INTEGER*4 TYPE /5/ -+ INTEGER*8 DEFVAL /0/ -+ CHARACTER*(5) NAME /'tests'/ -+ LOGICAL*1 NIL /0/ -+ END TYPE STRUCT1 -+ -+ TYPE (STRUCT1) SINST -+ -+ IF(SINST%ID.NE.8) STOP 1 -+ IF(SINST%TYPE.NE.5) STOP 2 -+ IF(SINST%DEFVAL.NE.0) STOP 3 -+ IF(SINST%NAME.NE.'tests') STOP 4 -+ IF(SINST%NIL) STOP 5 -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f -new file mode 100644 -index 00000000000..58c2b4b66cf ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f -@@ -0,0 +1,26 @@ -+! { dg-do compile } -+! { dg-options "-std=legacy -fdec -fno-dec-old-init" } -+! -+! Test old style initializers in derived types -+! -+! Contributed by Jim MacArthur -+! Modified by Mark Eggleston -+! -+ -+ PROGRAM spec_in_var -+ TYPE STRUCT1 -+ INTEGER*4 ID /8/ ! { dg-error "Invalid old style initialization" } -+ INTEGER*4 TYPE /5/ ! { dg-error "Invalid old style initialization" } -+ INTEGER*8 DEFVAL /0/ ! { dg-error "Invalid old style initialization" } -+ CHARACTER*(5) NAME /'tests'/ ! { dg-error "Invalid old style initialization" } -+ LOGICAL*1 NIL /0/ ! { dg-error "Invalid old style initialization" } -+ END TYPE STRUCT1 -+ -+ TYPE (STRUCT1) SINST -+ -+ IF(SINST%ID.NE.8) STOP 1 ! { dg-error "'id' at \\(1\\) is not a member" } -+ IF(SINST%TYPE.NE.5) STOP 2 ! { dg-error "'type' at \\(1\\) is not a member" } -+ IF(SINST%DEFVAL.NE.0) STOP 3 ! { dg-error "'defval' at \\(1\\) is not a member" } -+ IF(SINST%NAME.NE.'tests') STOP 4 ! { dg-error "'name' at \\(1\\) is not a member" } -+ IF(SINST%NIL) STOP 5 ! { dg-error "'nil' at \\(1\\) is not a member" } -+ END --- -2.27.0 - diff --git a/gcc12-fortran-fdec-override-kind.patch b/gcc12-fortran-fdec-override-kind.patch index 4df6ead71a39e66b49c1883330a41d90dfdedff8..370fa56191a21c913322737d1be2d52aa81f02d5 100644 --- a/gcc12-fortran-fdec-override-kind.patch +++ b/gcc12-fortran-fdec-override-kind.patch @@ -281,25 +281,25 @@ diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 25cc948699b..4a269ebb22d 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt -@@ -493,6 +493,10 @@ fdec-non-integer-index - Fortran Var(flag_dec_non_integer_index) - Enable support for non-integer substring indexes. +@@ -502,6 +502,10 @@ fdec-math + Fortran Var(flag_dec_math) + Enable legacy math intrinsics for compatibility. +fdec-override-kind +Fortran Var(flag_dec_override_kind) +Enable support for per variable kind specification. + - fdec-old-init - Fortran Var(flag_dec_old_init) - Enable support for old style initializers in derived types. + fdec-structure + Fortran Var(flag_dec_structure) + Enable support for DEC STRUCTURE/RECORD. diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc index d6bd36c3a8a..edbab483b36 100644 --- a/gcc/fortran/options.cc +++ b/gcc/fortran/options.cc -@@ -80,6 +80,7 @@ set_dec_flags (int value) +@@ -78,6 +78,7 @@ set_dec_flags (int value) + SET_BITFLAG (flag_dec_blank_format_item, value, value); + SET_BITFLAG (flag_dec_char_conversions, value, value); SET_BITFLAG (flag_dec_duplicates, value, value); - SET_BITFLAG (flag_dec_non_integer_index, value, value); - SET_BITFLAG (flag_dec_old_init, value, value); + SET_BITFLAG (flag_dec_override_kind, value, value); } diff --git a/gcc12-fortran-fdec-promotion.patch b/gcc12-fortran-fdec-promotion.patch deleted file mode 100644 index 870d62a633bc222eb5c02ec5ad7e952b6307bc1e..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-promotion.patch +++ /dev/null @@ -1,2093 +0,0 @@ -From 7a27318818e359a277f2fa5f7dc3932d0fb950f5 Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 14:58:07 +0000 -Subject: [PATCH 08/10] Support type promotion in calls to intrinsics - -Use -fdec-promotion or -fdec to enable this feature. - -Merged 2 commits: worked on by Ben Brewer , -Francisco Redondo Marchena and -Jeff Law - -Re-worked by Mark Eggleston ---- - gcc/fortran/check.cc | 71 +++++- - gcc/fortran/intrinsic.cc | 5 + - gcc/fortran/iresolve.cc | 91 ++++--- - gcc/fortran/lang.opt | 4 + - gcc/fortran/options.cc | 1 + - gcc/fortran/simplify.cc | 240 ++++++++++++++---- - ...trinsic_int_real_array_const_promotion_1.f | 18 ++ - ...trinsic_int_real_array_const_promotion_2.f | 18 ++ - ...trinsic_int_real_array_const_promotion_3.f | 18 ++ - ...dec_intrinsic_int_real_const_promotion_1.f | 90 +++++++ - ...dec_intrinsic_int_real_const_promotion_2.f | 90 +++++++ - ...dec_intrinsic_int_real_const_promotion_3.f | 92 +++++++ - .../dec_intrinsic_int_real_promotion_1.f | 130 ++++++++++ - .../dec_intrinsic_int_real_promotion_2.f | 130 ++++++++++ - .../dec_intrinsic_int_real_promotion_3.f | 130 ++++++++++ - .../dec_intrinsic_int_real_promotion_4.f | 118 +++++++++ - .../dec_intrinsic_int_real_promotion_5.f | 118 +++++++++ - .../dec_intrinsic_int_real_promotion_6.f | 118 +++++++++ - .../dec_intrinsic_int_real_promotion_7.f | 118 +++++++++ - .../gfortran.dg/dec_kind_promotion-1.f | 40 +++ - .../gfortran.dg/dec_kind_promotion-2.f | 40 +++ - .../gfortran.dg/dec_kind_promotion-3.f | 39 +++ - 22 files changed, 1639 insertions(+), 80 deletions(-) - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f - -diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc -index 623c1cc470e..e20a834a860 100644 ---- a/gcc/fortran/check.cc -+++ b/gcc/fortran/check.cc -@@ -1396,12 +1396,40 @@ gfc_check_allocated (gfc_expr *array) - } - - -+/* Check function where both arguments must be real or integer -+ and warn if they are different types. */ -+ -+bool -+check_int_real_promotion (gfc_expr *a, gfc_expr *b) -+{ -+ gfc_expr *i; -+ -+ if (!int_or_real_check (a, 0)) -+ return false; -+ -+ if (!int_or_real_check (b, 1)) -+ return false; -+ -+ if (a->ts.type != b->ts.type) -+ { -+ i = (a->ts.type != BT_REAL ? a : b); -+ gfc_warning_now (OPT_Wconversion, "Conversion from INTEGER to REAL " -+ "at %L might lose precision", &i->where); -+ } -+ -+ return true; -+} -+ -+ - /* Common check function where the first argument must be real or - integer and the second argument must be the same as the first. */ - - bool - gfc_check_a_p (gfc_expr *a, gfc_expr *p) - { -+ if (flag_dec_promotion) -+ return check_int_real_promotion (a, p); -+ - if (!int_or_real_check (a, 0)) - return false; - -@@ -3724,6 +3752,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) - } - - -+/* Check function where all arguments of an argument list must be real -+ or integer. */ -+ -+static bool -+check_rest_int_real (gfc_actual_arglist *arglist) -+{ -+ gfc_actual_arglist *arg, *tmp; -+ gfc_expr *x; -+ int m, n; -+ -+ if (!min_max_args (arglist)) -+ return false; -+ -+ for (arg = arglist, n=1; arg; arg = arg->next, n++) -+ { -+ x = arg->expr; -+ if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) -+ { -+ gfc_error ("% argument of %qs intrinsic at %L must be " -+ "INTEGER or REAL", n, gfc_current_intrinsic, &x->where); -+ return false; -+ } -+ -+ for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) -+ if (!gfc_check_conformance (tmp->expr, x, -+ "arguments 'a%d' and 'a%d' for " -+ "intrinsic '%s'", m, n, -+ gfc_current_intrinsic)) -+ return false; -+ } -+ -+ return true; -+} -+ -+ - bool - gfc_check_min_max (gfc_actual_arglist *arg) - { -@@ -3748,7 +3811,10 @@ gfc_check_min_max (gfc_actual_arglist *arg) - return false; - } - -- return check_rest (x->ts.type, x->ts.kind, arg); -+ if (flag_dec_promotion && x->ts.type != BT_CHARACTER) -+ return check_rest_int_real (arg); -+ else -+ return check_rest (x->ts.type, x->ts.kind, arg); - } - - -@@ -5121,6 +5187,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift) - bool - gfc_check_sign (gfc_expr *a, gfc_expr *b) - { -+ if (flag_dec_promotion) -+ return check_int_real_promotion (a, b); -+ - if (!int_or_real_check (a, 0)) - return false; - -diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc -index e68eff8bdbb..81b3a24c2be 100644 ---- a/gcc/fortran/intrinsic.cc -+++ b/gcc/fortran/intrinsic.cc -@@ -4467,6 +4467,11 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, - if (ts.kind == 0) - ts.kind = actual->expr->ts.kind; - -+ /* If kind promotion is allowed don't check for kind if it is smaller */ -+ if (flag_dec_promotion && ts.type == BT_INTEGER) -+ if (actual->expr->ts.kind < ts.kind) -+ ts.kind = actual->expr->ts.kind; -+ - if (!gfc_compare_types (&ts, &actual->expr->ts)) - { - if (error_flag) -diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc -index e17fe45f080..b9cdaff2499 100644 ---- a/gcc/fortran/iresolve.cc -+++ b/gcc/fortran/iresolve.cc -@@ -834,19 +834,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr - void - gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), -@@ -1622,14 +1625,17 @@ gfc_resolve_minmax (const char *name, gf - /* Find the largest type kind. */ - for (a = args->next; a; a = a->next) - { -+ if (a->expr-> ts.type == BT_REAL) -+ f->ts.type = BT_REAL; -+ - if (a->expr->ts.kind > f->ts.kind) - f->ts.kind = a->expr->ts.kind; - } - -- /* Convert all parameters to the required kind. */ -+ /* Convert all parameters to the required type and/or kind. */ - for (a = args; a; a = a->next) - { -- if (a->expr->ts.kind != f->ts.kind) -+ if (a->expr->ts.type != f->ts.type || a->expr->ts.kind != f->ts.kind) - gfc_convert_type (a->expr, &f->ts, 2); - } - -@@ -2130,19 +2136,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_exp - void - gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), -@@ -2153,19 +2162,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr * - void - gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), -@@ -2543,9 +2555,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr - - - void --gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) -+gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b) - { -- f->ts = a->ts; -+ if (b != NULL) -+ { -+ f->ts.kind = gfc_kind_max (a, b); -+ if (a->ts.type == BT_REAL || b->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; -+ else -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (b->ts.kind != f->ts.kind || b->ts.type != f->ts.type) -+ gfc_convert_type (b, &f->ts, 2); -+ } -+ else -+ { -+ f->ts = a->ts; -+ } - f->value.function.name - = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), - gfc_type_abi_kind (&a->ts)); -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index d886c2f33ed..4ca2f93f2df 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -505,6 +505,10 @@ fdec-old-init - Fortran Var(flag_dec_old_init) - Enable support for old style initializers in derived types. - -+fdec-promotion -+Fortran Var(flag_dec_promotion) -+Add support for type promotion in intrinsic arguments. -+ - fdec-structure - Fortran Var(flag_dec_structure) - Enable support for DEC STRUCTURE/RECORD. -diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc -index a946c86790a..15079c7e95a 100644 ---- a/gcc/fortran/options.cc -+++ b/gcc/fortran/options.cc -@@ -82,6 +82,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_old_init, value, value); - SET_BITFLAG (flag_dec_override_kind, value, value); - SET_BITFLAG (flag_dec_non_logical_if, value, value); -+ SET_BITFLAG (flag_dec_promotion, value, value); - } - - /* Finalize DEC flags. */ -diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc -index 9900572424f..3419e06fec2 100644 ---- a/gcc/fortran/simplify.cc -+++ b/gcc/fortran/simplify.cc -@@ -2333,39 +2333,79 @@ gfc_simplify_digits (gfc_expr *x) - } - - -+/* Simplify function which sets the floating-point value of ar from -+ the value of a independently if a is integer of real. */ -+ -+static void -+simplify_int_real_promotion (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar) -+{ -+ if (a->ts.type == BT_REAL) -+ { -+ mpfr_init2 (*ar, (a->ts.kind * 8)); -+ mpfr_set (*ar, a->value.real, GFC_RND_MODE); -+ } -+ else -+ { -+ mpfr_init2 (*ar, (b->ts.kind * 8)); -+ mpfr_set_z (*ar, a->value.integer, GFC_RND_MODE); -+ } -+} -+ -+ -+/* Simplify function which promotes a and b arguments from integer to real if -+ required in ar and br floating-point values. This function returns true if -+ a or b are reals and false otherwise. */ -+ -+static bool -+simplify_int_real_promotion2 (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar, -+ mpfr_t *br) -+{ -+ if (a->ts.type != BT_REAL && b->ts.type != BT_REAL) -+ return false; -+ -+ simplify_int_real_promotion (a, b, ar); -+ simplify_int_real_promotion (b, a, br); -+ -+ return true; -+} -+ -+ - gfc_expr * - gfc_simplify_dim (gfc_expr *x, gfc_expr *y) - { - gfc_expr *result; - int kind; - -+ mpfr_t xr; -+ mpfr_t yr; -+ - if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) - return NULL; - -- kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; -- result = gfc_get_constant_expr (x->ts.type, kind, &x->where); -- -- switch (x->ts.type) -+ if ((x->ts.type != BT_REAL && x->ts.type != BT_INTEGER) -+ || (y->ts.type != BT_REAL && y->ts.type != BT_INTEGER)) - { -- case BT_INTEGER: -- if (mpz_cmp (x->value.integer, y->value.integer) > 0) -- mpz_sub (result->value.integer, x->value.integer, y->value.integer); -- else -- mpz_set_ui (result->value.integer, 0); -- -- break; -- -- case BT_REAL: -- if (mpfr_cmp (x->value.real, y->value.real) > 0) -- mpfr_sub (result->value.real, x->value.real, y->value.real, -- GFC_RND_MODE); -- else -- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); -+ gfc_internal_error ("gfc_simplify_dim(): Bad arguments"); -+ return NULL; -+ } - -- break; -+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; - -- default: -- gfc_internal_error ("gfc_simplify_dim(): Bad type"); -+ if (simplify_int_real_promotion2 (x, y, &xr, &yr)) -+ { -+ result = gfc_get_constant_expr (BT_REAL, kind, &x->where); -+ if (mpfr_cmp (xr, yr) > 0) -+ mpfr_sub (result->value.real, xr, yr, GFC_RND_MODE); -+ else -+ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where); -+ if (mpz_cmp (x->value.integer, y->value.integer) > 0) -+ mpz_sub (result->value.integer, x->value.integer, y->value.integer); -+ else -+ mpz_set_ui (result->value.integer, 0); - } - - return range_check (result, "DIM"); -@@ -4953,6 +4993,76 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val) - { - int ret; - -+ mpfr_t *arp; -+ mpfr_t *erp; -+ mpfr_t ar; -+ mpfr_t er; -+ -+ if (arg->ts.type != extremum->ts.type) -+ { -+ if (arg->ts.type == BT_REAL) -+ { -+ arp = &arg->value.real; -+ } -+ else -+ { -+ mpfr_init2 (ar, (arg->ts.kind * 8)); -+ mpfr_set_z (ar, arg->value.integer, GFC_RND_MODE); -+ arp = &ar; -+ } -+ -+ if (extremum->ts.type == BT_REAL) -+ { -+ erp = &extremum->value.real; -+ } -+ else -+ { -+ mpfr_init2 (er, (extremum->ts.kind * 8)); -+ mpfr_set_z (er, extremum->value.integer, GFC_RND_MODE); -+ erp = &er; -+ } -+ -+ if (mpfr_nan_p (*erp)) -+ { -+ ret = 1; -+ extremum->ts.type = arg->ts.type; -+ extremum->ts.kind = arg->ts.kind; -+ if (arg->ts.type == BT_INTEGER) -+ { -+ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); -+ mpz_set (extremum->value.integer, arg->value.integer); -+ } -+ else -+ { -+ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); -+ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); -+ } -+ } -+ else if (mpfr_nan_p (*arp)) -+ ret = -1; -+ else -+ { -+ ret = mpfr_cmp (*arp, *erp) * sign; -+ if (ret > 0) -+ { -+ extremum->ts.type = arg->ts.type; -+ extremum->ts.kind = arg->ts.kind; -+ if (arg->ts.type == BT_INTEGER) -+ { -+ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); -+ mpz_set (extremum->value.integer, arg->value.integer); -+ } -+ else -+ { -+ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); -+ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); -+ } -+ } -+ } -+ -+ return ret; -+ } -+ - switch (arg->ts.type) - { - case BT_INTEGER: -@@ -5912,7 +6022,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) - gfc_expr *result; - int kind; - -- /* First check p. */ -+ mpfr_t ar; -+ mpfr_t pr; -+ - if (p->expr_type != EXPR_CONSTANT) - return NULL; - -@@ -5942,16 +6054,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) - if (a->expr_type != EXPR_CONSTANT) - return NULL; - -+ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) -+ { -+ gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); -+ return NULL; -+ } -+ - kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; -- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); - -- if (a->ts.type == BT_INTEGER) -- mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); -- else -+ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) - { -+ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); - gfc_set_model_kind (kind); -- mpfr_fmod (result->value.real, a->value.real, p->value.real, -- GFC_RND_MODE); -+ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); -+ mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); - } - - return range_check (result, "MOD"); -@@ -5964,7 +6084,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) - gfc_expr *result; - int kind; - -- /* First check p. */ -+ mpfr_t ar; -+ mpfr_t pr; -+ - if (p->expr_type != EXPR_CONSTANT) - return NULL; - -@@ -5991,28 +6113,36 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) - gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); - } - -+ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) -+ { -+ gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); -+ return NULL; -+ } -+ - if (a->expr_type != EXPR_CONSTANT) - return NULL; - - kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; -- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); - -- if (a->ts.type == BT_INTEGER) -- mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); -- else -+ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) - { -+ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); - gfc_set_model_kind (kind); -- mpfr_fmod (result->value.real, a->value.real, p->value.real, -- GFC_RND_MODE); -+ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); - if (mpfr_cmp_ui (result->value.real, 0) != 0) -- { -- if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) -- mpfr_add (result->value.real, result->value.real, p->value.real, -- GFC_RND_MODE); -- } -- else -- mpfr_copysign (result->value.real, result->value.real, -- p->value.real, GFC_RND_MODE); -+ { -+ if (mpfr_signbit (ar) != mpfr_signbit (pr)) -+ mpfr_add (result->value.real, result->value.real, pr, -+ GFC_RND_MODE); -+ } -+ else -+ mpfr_copysign (result->value.real, result->value.real, pr, -+ GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); -+ mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); - } - - return range_check (result, "MODULO"); -@@ -7578,27 +7708,41 @@ gfc_expr * - gfc_simplify_sign (gfc_expr *x, gfc_expr *y) - { - gfc_expr *result; -+ bool neg; - - if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) - return NULL; - - result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); - -+ switch (y->ts.type) -+ { -+ case BT_INTEGER: -+ neg = (mpz_sgn (y->value.integer) < 0); -+ break; -+ -+ case BT_REAL: -+ neg = (mpfr_sgn (y->value.real) < 0); -+ break; -+ -+ default: -+ gfc_internal_error ("Bad type in gfc_simplify_sign"); -+ } -+ - switch (x->ts.type) - { - case BT_INTEGER: - mpz_abs (result->value.integer, x->value.integer); -- if (mpz_sgn (y->value.integer) < 0) -+ if (neg) - mpz_neg (result->value.integer, result->value.integer); - break; - - case BT_REAL: -- if (flag_sign_zero) -+ if (flag_sign_zero && y->ts.type == BT_REAL) - mpfr_copysign (result->value.real, x->value.real, y->value.real, -- GFC_RND_MODE); -+ GFC_RND_MODE); - else -- mpfr_setsign (result->value.real, x->value.real, -- mpfr_sgn (y->value.real) < 0 ? 1 : 0, GFC_RND_MODE); -+ mpfr_setsign (result->value.real, x->value.real, neg, GFC_RND_MODE); - break; - - default: -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f -new file mode 100644 -index 00000000000..25763852139 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals for mod and modulo where -+! A is a constant array and P is zero. -+! -+! Compilation errors are expected -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ program promotion_int_real_array_const -+ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ a = mod([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f -new file mode 100644 -index 00000000000..b78a46054f4 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-fdec-promotion" } -+! -+! Test promotion between integers and reals for mod and modulo where -+! A is a constant array and P is zero. -+! -+! Compilation errors are expected -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ program promotion_int_real_array_const -+ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ a = mod([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f -new file mode 100644 -index 00000000000..318ab5db97e ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-promotion" } -+! -+! Test promotion between integers and reals for mod and modulo where -+! A is a constant array and P is zero. -+! -+! Compilation errors are expected -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ program promotion_int_real_array_const -+ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "'a' and 'p' arguments of 'mod'" } -+ a = mod([12.0, 34.0], 0)*4 ! { dg-error "'a' and 'p' arguments of 'mod'" } -+ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "'a' and 'p' arguments of 'modulo'" } -+ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "'a' and 'p' arguments of 'modulo'" } -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f -new file mode 100644 -index 00000000000..27eb2582bb2 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f -@@ -0,0 +1,90 @@ -+! { dg-do run } -+! { dg-options "-fdec -finit-real=snan" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real_const -+ ! array_nan 4th position value is NAN -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(4, 3) -+ if (m_i .ne. 1) STOP 1 -+ m_r = MOD(4.0, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 -+ m_r = MOD(4, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(4.0, 3) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ -+ md_i = MODULO(4, 3) -+ if (md_i .ne. 1) STOP 5 -+ md_r = MODULO(4.0, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 -+ md_r = MODULO(4, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 -+ md_r = MODULO(4.0, 3) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 -+ -+ d_i = DIM(4, 3) -+ if (d_i .ne. 1) STOP 9 -+ d_r = DIM(4.0, 3.0) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 -+ d_r = DIM(4.0, 3) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 -+ d_r = DIM(3, 4.0) -+ if (abs(d_r) > 1.0D-6) STOP 12 -+ -+ s_i = SIGN(-4, 3) -+ if (s_i .ne. 4) STOP 13 -+ s_r = SIGN(4.0, -3.0) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 -+ s_r = SIGN(4.0, -3) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 -+ s_r = SIGN(-4, 3.0) -+ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 -+ -+ mx_i = MAX(-4, -3, 2, 1) -+ if (mx_i .ne. 2) STOP 17 -+ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 -+ mx_r = MAX(-4, -3.0, 2.0, 1) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 20 -+ -+ mn_i = MIN(-4, -3, 2, 1) -+ if (mn_i .ne. -4) STOP 21 -+ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 -+ mn_r = MIN(-4, -3.0, 2.0, 1) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 24 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f -new file mode 100644 -index 00000000000..bdd017b7280 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f -@@ -0,0 +1,90 @@ -+! { dg-do run } -+! { dg-options "-fdec-promotion -finit-real=snan" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real_const -+ ! array_nan 4th position value is NAN -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(4, 3) -+ if (m_i .ne. 1) STOP 1 -+ m_r = MOD(4.0, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 -+ m_r = MOD(4, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(4.0, 3) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ -+ md_i = MODULO(4, 3) -+ if (md_i .ne. 1) STOP 5 -+ md_r = MODULO(4.0, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 -+ md_r = MODULO(4, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 -+ md_r = MODULO(4.0, 3) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 -+ -+ d_i = DIM(4, 3) -+ if (d_i .ne. 1) STOP 9 -+ d_r = DIM(4.0, 3.0) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 -+ d_r = DIM(4.0, 3) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 -+ d_r = DIM(3, 4.0) -+ if (abs(d_r) > 1.0D-6) STOP 12 -+ -+ s_i = SIGN(-4, 3) -+ if (s_i .ne. 4) STOP 13 -+ s_r = SIGN(4.0, -3.0) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 -+ s_r = SIGN(4.0, -3) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 -+ s_r = SIGN(-4, 3.0) -+ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 -+ -+ mx_i = MAX(-4, -3, 2, 1) -+ if (mx_i .ne. 2) STOP 17 -+ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 -+ mx_r = MAX(-4, -3.0, 2.0, 1) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 20 -+ -+ mn_i = MIN(-4, -3, 2, 1) -+ if (mn_i .ne. -4) STOP 21 -+ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 -+ mn_r = MIN(-4, -3.0, 2.0, 1) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 24 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f -new file mode 100644 -index 00000000000..ce90a5667d6 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f -@@ -0,0 +1,92 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-promotion -finit-real=snan" } -+! -+! Test that there is no promotion between integers and reals in -+! intrinsic operations. -+! -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real_const -+ ! array_nan 4th position value is NAN -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(4, 3) -+ if (m_i .ne. 1) STOP 1 -+ m_r = MOD(4.0, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 -+ m_r = MOD(4, 3.0) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(4.0, 3) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ -+ md_i = MODULO(4, 3) -+ if (md_i .ne. 1) STOP 5 -+ md_r = MODULO(4.0, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 -+ md_r = MODULO(4, 3.0) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 -+ md_r = MODULO(4.0, 3) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 -+ -+ d_i = DIM(4, 3) -+ if (d_i .ne. 1) STOP 9 -+ d_r = DIM(4.0, 3.0) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 -+ d_r = DIM(4.0, 3) ! { dg-error "'x' and 'y' arguments" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 -+ d_r = DIM(3, 4.0) ! { dg-error "'x' and 'y' arguments" } -+ if (abs(d_r) > 1.0D-6) STOP 12 -+ -+ s_i = SIGN(-4, 3) -+ if (s_i .ne. 4) STOP 13 -+ s_r = SIGN(4.0, -3.0) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 -+ s_r = SIGN(4.0, -3) ! { dg-error "'b' argument" } -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 -+ s_r = SIGN(-4, 3.0) ! { dg-error "'b' argument" } -+ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 -+ -+ mx_i = MAX(-4, -3, 2, 1) -+ if (mx_i .ne. 2) STOP 17 -+ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 -+ mx_r = MAX(-4, -3.0, 2.0, 1) ! { dg-error "'a2' argument" } -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 20 -+ -+ mn_i = MIN(-4, -3, 2, 1) -+ if (mn_i .ne. -4) STOP 21 -+ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 -+ mn_r = MIN(-4, -3.0, 2.0, 1) ! { dg-error "'a2' argument" } -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 24 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f -new file mode 100644 -index 00000000000..5c2cd931a4b ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f -@@ -0,0 +1,130 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ INTEGER b_i/3/ -+ INTEGER*8 b2_i/3/ -+ INTEGER x_i/2/ -+ INTEGER y_i/1/ -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ REAL b_r/3.0/ -+ REAL*8 b2_r/3.0/ -+ REAL x_r/2.0/ -+ REAL y_r/1.0/ -+ -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ ! array_nan 4th position value is NAN -+ array_nan(4) = 0/l -+ -+ m_i = MOD(a_i, b_i) -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_i) -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_i) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_i) -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_i) -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_i) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_i) -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_i) -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_i) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_i, a_r) -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_i) -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_i) -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_r) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_r) -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_i) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_r) -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_r, x_r, y_i) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 30 -+ -+ mn_i = MIN(-a_i, -b_i, x_i, y_i) -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_r, x_r, y_r) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_r, x_r, y_i) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 36 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f -new file mode 100644 -index 00000000000..d64d468f7d1 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f -@@ -0,0 +1,130 @@ -+! { dg-do run } -+! { dg-options "-fdec-promotion" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ INTEGER b_i/3/ -+ INTEGER*8 b2_i/3/ -+ INTEGER x_i/2/ -+ INTEGER y_i/1/ -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ REAL b_r/3.0/ -+ REAL*8 b2_r/3.0/ -+ REAL x_r/2.0/ -+ REAL y_r/1.0/ -+ -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ ! array_nan 4th position value is NAN -+ array_nan(4) = 0/l -+ -+ m_i = MOD(a_i, b_i) -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_i) -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_i) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_i) -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_i) -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_i) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_i) -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_i) -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_i) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_i, a_r) -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_i) -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_i) -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_r) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_r) -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_i) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_r) -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_r, x_r, y_i) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 30 -+ -+ mn_i = MIN(-a_i, -b_i, x_i, y_i) -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_r, x_r, y_r) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_r, x_r, y_i) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 36 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f -new file mode 100644 -index 00000000000..0708b666633 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f -@@ -0,0 +1,130 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-promotion" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ INTEGER b_i/3/ -+ INTEGER*8 b2_i/3/ -+ INTEGER x_i/2/ -+ INTEGER y_i/1/ -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ REAL b_r/3.0/ -+ REAL*8 b2_r/3.0/ -+ REAL x_r/2.0/ -+ REAL y_r/1.0/ -+ -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ ! array_nan 4th position value is NAN -+ array_nan(4) = 0/l -+ -+ m_i = MOD(a_i, b_i) -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_i) -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_r) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_i) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_i) -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_i) -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_r) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_i) ! { dg-error "'a' and 'p' arguments" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_i) -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_i) -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_i) ! { dg-error "'x' and 'y' arguments" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_i, a_r) ! { dg-error "'x' and 'y' arguments" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_i) -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_i) ! { dg-error "'b' argument" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_r) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_r) ! { dg-error "'b' argument" } -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_i) ! { dg-error "'b' argument" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_r) ! { dg-error "'b' argument" } -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_r, x_r, y_i) ! { dg-error "'a2' argument" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 30 -+ -+ mn_i = MIN(-a_i, -b_i, x_i, y_i) -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_r, x_r, y_r) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_r, x_r, y_i) ! { dg-error "'a2' argument" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 36 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f -new file mode 100644 -index 00000000000..efa4f236410 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f -@@ -0,0 +1,118 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ LOGICAL a_l -+ LOGICAL*4 a2_l -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ LOGICAL x_l -+ LOGICAL y_l -+ CHARACTER a_c -+ CHARACTER*4 a2_c -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ CHARACTER x_c -+ CHARACTER y_c -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_l, b_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_l, b2_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_c, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_c, b2_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_l, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_c, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_l, b_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_l, b2_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_c, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_c, b2_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_l, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_c, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_l, b_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_l, b2_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_c, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_c, b2_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_c, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_l, a_c) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_l, b_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_l, b2_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_c, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" } -+ s_r = SIGN(a2_c, -b2_c) ! { dg-error "" } -+ if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" } -+ s_r = SIGN(a_c, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" } -+ s_r = SIGN(-a_l, b_c) ! { dg-error "" } -+ if (abs(s_r - a_c) > 1.0D-6) STOP 24 ! { dg-error "" } -+ -+ mx_i = MAX(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 25 ! { dg-error "" } -+ mx_i = MAX(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 26 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 27 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 28 ! { dg-error "" } -+ mx_r = MAX(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 29 ! { dg-error "" } -+ -+ mn_i = MIN(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a_l) STOP 31 ! { dg-error "" } -+ mn_i = MIN(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a2_l) STOP 32 ! { dg-error "" } -+ mn_r = MIN(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" } -+ mn_r = MIN(-a2_c, -b2_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" } -+ mn_r = MIN(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" } -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f -new file mode 100644 -index 00000000000..d023af5086d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f -@@ -0,0 +1,118 @@ -+! { dg-do compile } -+! { dg-options "-fdec-promotion" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ LOGICAL a_l -+ LOGICAL*4 a2_l -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ LOGICAL x_l -+ LOGICAL y_l -+ CHARACTER a_c -+ CHARACTER*4 a2_c -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ CHARACTER x_c -+ CHARACTER y_c -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_l, b_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_l, b2_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_c, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_c, b2_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_l, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_c, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_l, b_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_l, b2_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_c, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_c, b2_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_l, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_c, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_l, b_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_l, b2_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_c, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_c, b2_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_c, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_l, a_c) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_l, b_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_l, b2_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_c, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" } -+ s_r = SIGN(a2_c, -b2_c) ! { dg-error "" } -+ if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" } -+ s_r = SIGN(a_c, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" } -+ s_r = SIGN(-a_l, b_c) ! { dg-error "" } -+ if (abs(s_r - a_c) > 1.0D-6) STOP 24 ! { dg-error "" } -+ -+ mx_i = MAX(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 25 ! { dg-error "" } -+ mx_i = MAX(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 26 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 27 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 28 ! { dg-error "" } -+ mx_r = MAX(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 29 ! { dg-error "" } -+ -+ mn_i = MIN(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a_l) STOP 31 ! { dg-error "" } -+ mn_i = MIN(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a2_l) STOP 32 ! { dg-error "" } -+ mn_r = MIN(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" } -+ mn_r = MIN(-a2_c, -b2_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" } -+ mn_r = MIN(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" } -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f -new file mode 100644 -index 00000000000..00f8fb88f1b ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f -@@ -0,0 +1,118 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ INTEGER x_i/2/ -+ CHARACTER y_c -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ REAL x_r/2.0/ -+ LOGICAL y_l -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_i, b_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_c, a_r) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_l) ! { dg-error "" } -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_l) ! { dg-error "" } -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ -+ mn_i = MIN(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f -new file mode 100644 -index 00000000000..1d4150d81c0 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f -@@ -0,0 +1,118 @@ -+! { dg-do compile } -+! { dg-options "-fdec-promotion" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+! Contributed by Francisco Redondo Marchena -+! and Jeff Law -+! Modified by Mark Eggleston -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ INTEGER x_i/2/ -+ CHARACTER y_c -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ REAL x_r/2.0/ -+ LOGICAL y_l -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_i, b_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_c, a_r) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_l) ! { dg-error "" } -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_l) ! { dg-error "" } -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ -+ mn_i = MIN(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f -new file mode 100644 -index 00000000000..435bf98350c ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f -@@ -0,0 +1,40 @@ -+!{ dg-do run } -+!{ dg-options "-fdec" } -+! -+! integer types of a smaller kind than expected should be -+! accepted by type specific intrinsic functions -+! -+! Contributed by Mark Eggleston -+! -+ program test_small_type_promtion -+ implicit none -+ integer(1) :: a = 1 -+ integer :: i -+ if (iiabs(-9_1).ne.9) stop 1 -+ if (iabs(-9_1).ne.9) stop 2 -+ if (iabs(-9_2).ne.9) stop 3 -+ if (jiabs(-9_1).ne.9) stop 4 -+ if (jiabs(-9_2).ne.9) stop 5 -+ if (iishft(1_1, 2).ne.4) stop 6 -+ if (jishft(1_1, 2).ne.4) stop 7 -+ if (jishft(1_2, 2).ne.4) stop 8 -+ if (kishft(1_1, 2).ne.4) stop 9 -+ if (kishft(1_2, 2).ne.4) stop 10 -+ if (kishft(1_4, 2).ne.4) stop 11 -+ if (imod(17_1, 3).ne.2) stop 12 -+ if (jmod(17_1, 3).ne.2) stop 13 -+ if (jmod(17_2, 3).ne.2) stop 14 -+ if (kmod(17_1, 3).ne.2) stop 15 -+ if (kmod(17_2, 3).ne.2) stop 16 -+ if (kmod(17_4, 3).ne.2) stop 17 -+ if (inot(5_1).ne.-6) stop 18 -+ if (jnot(5_1).ne.-6) stop 19 -+ if (jnot(5_2).ne.-6) stop 20 -+ if (knot(5_1).ne.-6) stop 21 -+ if (knot(5_2).ne.-6) stop 22 -+ if (knot(5_4).ne.-6) stop 23 -+ if (isign(-77_1, 1).ne.77) stop 24 -+ if (isign(-77_1, -1).ne.-77) stop 25 -+ if (isign(-77_2, 1).ne.77) stop 26 -+ if (isign(-77_2, -1).ne.-77) stop 27 -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f -new file mode 100644 -index 00000000000..7b1697ca665 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f -@@ -0,0 +1,40 @@ -+!{ dg-do run } -+!{ dg-options "-fdec-intrinsic-ints -fdec-promotion" } -+! -+! integer types of a smaller kind than expected should be -+! accepted by type specific intrinsic functions -+! -+! Contributed by Mark Eggleston -+! -+ program test_small_type_promtion -+ implicit none -+ integer(1) :: a = 1 -+ integer :: i -+ if (iiabs(-9_1).ne.9) stop 1 -+ if (iabs(-9_1).ne.9) stop 2 -+ if (iabs(-9_2).ne.9) stop 3 -+ if (jiabs(-9_1).ne.9) stop 4 -+ if (jiabs(-9_2).ne.9) stop 5 -+ if (iishft(1_1, 2).ne.4) stop 6 -+ if (jishft(1_1, 2).ne.4) stop 7 -+ if (jishft(1_2, 2).ne.4) stop 8 -+ if (kishft(1_1, 2).ne.4) stop 9 -+ if (kishft(1_2, 2).ne.4) stop 10 -+ if (kishft(1_4, 2).ne.4) stop 11 -+ if (imod(17_1, 3).ne.2) stop 12 -+ if (jmod(17_1, 3).ne.2) stop 13 -+ if (jmod(17_2, 3).ne.2) stop 14 -+ if (kmod(17_1, 3).ne.2) stop 15 -+ if (kmod(17_2, 3).ne.2) stop 16 -+ if (kmod(17_4, 3).ne.2) stop 17 -+ if (inot(5_1).ne.-6) stop 18 -+ if (jnot(5_1).ne.-6) stop 19 -+ if (jnot(5_2).ne.-6) stop 20 -+ if (knot(5_1).ne.-6) stop 21 -+ if (knot(5_2).ne.-6) stop 22 -+ if (knot(5_4).ne.-6) stop 23 -+ if (isign(-77_1, 1).ne.77) stop 24 -+ if (isign(-77_1, -1).ne.-77) stop 25 -+ if (isign(-77_2, 1).ne.77) stop 26 -+ if (isign(-77_2, -1).ne.-77) stop 27 -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f -new file mode 100644 -index 00000000000..db8dff6c55d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f -@@ -0,0 +1,39 @@ -+!{ dg-do compile } -+!{ dg-options "-fdec -fno-dec-promotion" } -+! -+! integer types of a smaller kind than expected should be -+! accepted by type specific intrinsic functions -+! -+! Contributed by Mark Eggleston -+! -+ program test_small_type_promtion -+ integer(1) :: a = 1 -+ integer :: i -+ if (iiabs(-9_1).ne.9) stop 1 -+ if (iabs(-9_1).ne.9) stop 2 ! { dg-error "type mismatch in argument" } -+ if (iabs(-9_2).ne.9) stop 3 ! { dg-error "type mismatch in argument" } -+ if (jiabs(-9_1).ne.9) stop 4 -+ if (jiabs(-9_2).ne.9) stop 5 -+ if (iishft(1_1, 2).ne.4) stop 6 -+ if (jishft(1_1, 2).ne.4) stop 7 -+ if (jishft(1_2, 2).ne.4) stop 8 -+ if (kishft(1_1, 2).ne.4) stop 9 -+ if (kishft(1_2, 2).ne.4) stop 10 -+ if (kishft(1_4, 2).ne.4) stop 11 -+ if (imod(17_1, 3).ne.2) stop 12 -+ if (jmod(17_1, 3).ne.2) stop 13 -+ if (jmod(17_2, 3).ne.2) stop 14 -+ if (kmod(17_1, 3).ne.2) stop 15 -+ if (kmod(17_2, 3).ne.2) stop 16 -+ if (kmod(17_4, 3).ne.2) stop 17 -+ if (inot(5_1).ne.-6) stop 18 -+ if (jnot(5_1).ne.-6) stop 19 -+ if (jnot(5_2).ne.-6) stop 20 -+ if (knot(5_1).ne.-6) stop 21 -+ if (knot(5_2).ne.-6) stop 22 -+ if (knot(5_4).ne.-6) stop 23 -+ if (isign(-77_1, 1).ne.77) stop 24 ! { dg-error "type mismatch in argument" } -+ if (isign(-77_1, -1).ne.-77) stop 25 ! { dg-error "type mismatch in argument" } -+ if (isign(-77_2, 1).ne.77) stop 26 ! { dg-error "type mismatch in argument" } -+ if (isign(-77_2, -1).ne.-77) stop 27 ! { dg-error "type mismatch in argument" } -+ end program --- -2.27.0 - diff --git a/gcc12-fortran-fdec-sequence.patch b/gcc12-fortran-fdec-sequence.patch deleted file mode 100644 index d79348e3cc4999dd2128184fa3b2f793d767ea91..0000000000000000000000000000000000000000 --- a/gcc12-fortran-fdec-sequence.patch +++ /dev/null @@ -1,262 +0,0 @@ -From bb76446db10c21860a4e19569ce3e350d8a2b59f Mon Sep 17 00:00:00 2001 -From: Mark Eggleston -Date: Fri, 22 Jan 2021 15:00:44 +0000 -Subject: [PATCH 09/10] Add the SEQUENCE attribute by default if it's not - present. - -Use -fdec-sequence to enable this feature. Also enabled by -fdec. ---- - gcc/fortran/lang.opt | 4 ++ - gcc/fortran/options.cc | 1 + - gcc/fortran/resolve.cc | 13 ++++- - ...dd_SEQUENCE_to_COMMON_block_by_default_1.f | 57 +++++++++++++++++++ - ...dd_SEQUENCE_to_COMMON_block_by_default_2.f | 57 +++++++++++++++++++ - ...dd_SEQUENCE_to_COMMON_block_by_default_3.f | 57 +++++++++++++++++++ - 6 files changed, 186 insertions(+), 3 deletions(-) - create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f - create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index 4ca2f93f2df..019c798cf09 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -509,6 +509,10 @@ fdec-promotion - Fortran Var(flag_dec_promotion) - Add support for type promotion in intrinsic arguments. - -+fdec-sequence -+Fortran Var(flag_dec_sequence) -+Add the SEQUENCE attribute by default if it's not present. -+ - fdec-structure - Fortran Var(flag_dec_structure) - Enable support for DEC STRUCTURE/RECORD. -diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc -index 15079c7e95a..050f56fdc25 100644 ---- a/gcc/fortran/options.cc -+++ b/gcc/fortran/options.cc -@@ -83,6 +83,7 @@ set_dec_flags (int value) - SET_BITFLAG (flag_dec_override_kind, value, value); - SET_BITFLAG (flag_dec_non_logical_if, value, value); - SET_BITFLAG (flag_dec_promotion, value, value); -+ SET_BITFLAG (flag_dec_sequence, value, value); - } - - /* Finalize DEC flags. */ -diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc -index 07dd039f3bf..fe7d0cc5944 100644 ---- a/gcc/fortran/resolve.cc -+++ b/gcc/fortran/resolve.cc -@@ -978,9 +978,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common) - - if (!(csym->ts.u.derived->attr.sequence - || csym->ts.u.derived->attr.is_bind_c)) -- gfc_error_now ("Derived type variable %qs in COMMON at %L " -- "has neither the SEQUENCE nor the BIND(C) " -- "attribute", csym->name, &csym->declared_at); -+ { -+ if (flag_dec_sequence) -+ /* Assume sequence. */ -+ csym->ts.u.derived->attr.sequence = 1; -+ else -+ gfc_error_now ("Derived type variable '%s' in COMMON at %L " -+ "has neither the SEQUENCE nor the BIND(C) " -+ "attribute", csym->name, &csym->declared_at); -+ } -+ - if (csym->ts.u.derived->attr.alloc_comp) - gfc_error_now ("Derived type variable %qs in COMMON at %L " - "has an ultimate component that is " -diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f -new file mode 100644 -index 00000000000..fe7b39625eb ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f -@@ -0,0 +1,57 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! Test add default SEQUENCE attribute derived types appearing in -+! COMMON blocks and EQUIVALENCE statements. -+! -+! Contributed by Francisco Redondo Marchena -+! Modified by Mark Eggleston -+! -+ MODULE SEQ -+ TYPE STRUCT1 -+ INTEGER*4 ID -+ INTEGER*4 TYPE -+ INTEGER*8 DEFVAL -+ CHARACTER*(4) NAME -+ LOGICAL*1 NIL -+ END TYPE STRUCT1 -+ END MODULE -+ -+ SUBROUTINE A -+ USE SEQ -+ TYPE (STRUCT1) S -+ COMMON /BLOCK1/ S -+ IF (S%ID.NE.5) STOP 1 -+ IF (S%TYPE.NE.1000) STOP 2 -+ IF (S%DEFVAL.NE.-99) STOP 3 -+ IF (S%NAME.NE."JANE") STOP 4 -+ IF (S%NIL.NEQV..FALSE.) STOP 5 -+ END SUBROUTINE -+ -+ PROGRAM sequence_att_common -+ USE SEQ -+ IMPLICIT NONE -+ TYPE (STRUCT1) S1 -+ TYPE (STRUCT1) S2 -+ TYPE (STRUCT1) S3 -+ -+ EQUIVALENCE (S1,S2) -+ COMMON /BLOCK1/ S3 -+ -+ S1%ID = 5 -+ S1%TYPE = 1000 -+ S1%DEFVAL = -99 -+ S1%NAME = "JANE" -+ S1%NIL = .FALSE. -+ -+ IF (S2%ID.NE.5) STOP 1 -+ IF (S2%TYPE.NE.1000) STOP 2 -+ IF (S2%DEFVAL.NE.-99) STOP 3 -+ IF (S2%NAME.NE."JANE") STOP 4 -+ IF (S2%NIL.NEQV..FALSE.) STOP 5 -+ -+ S3 = S1 -+ -+ CALL A -+ -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f -new file mode 100644 -index 00000000000..83512f0f3a2 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f -@@ -0,0 +1,57 @@ -+! { dg-do run } -+! { dg-options "-fdec-sequence" } -+! -+! Test add default SEQUENCE attribute derived types appearing in -+! COMMON blocks and EQUIVALENCE statements. -+! -+! Contributed by Francisco Redondo Marchena -+! Modified by Mark Eggleston -+! -+ MODULE SEQ -+ TYPE STRUCT1 -+ INTEGER*4 ID -+ INTEGER*4 TYPE -+ INTEGER*8 DEFVAL -+ CHARACTER*(4) NAME -+ LOGICAL*1 NIL -+ END TYPE STRUCT1 -+ END MODULE -+ -+ SUBROUTINE A -+ USE SEQ -+ TYPE (STRUCT1) S -+ COMMON /BLOCK1/ S -+ IF (S%ID.NE.5) STOP 1 -+ IF (S%TYPE.NE.1000) STOP 2 -+ IF (S%DEFVAL.NE.-99) STOP 3 -+ IF (S%NAME.NE."JANE") STOP 4 -+ IF (S%NIL.NEQV..FALSE.) STOP 5 -+ END SUBROUTINE -+ -+ PROGRAM sequence_att_common -+ USE SEQ -+ IMPLICIT NONE -+ TYPE (STRUCT1) S1 -+ TYPE (STRUCT1) S2 -+ TYPE (STRUCT1) S3 -+ -+ EQUIVALENCE (S1,S2) -+ COMMON /BLOCK1/ S3 -+ -+ S1%ID = 5 -+ S1%TYPE = 1000 -+ S1%DEFVAL = -99 -+ S1%NAME = "JANE" -+ S1%NIL = .FALSE. -+ -+ IF (S2%ID.NE.5) STOP 1 -+ IF (S2%TYPE.NE.1000) STOP 2 -+ IF (S2%DEFVAL.NE.-99) STOP 3 -+ IF (S2%NAME.NE."JANE") STOP 4 -+ IF (S2%NIL.NEQV..FALSE.) STOP 5 -+ -+ S3 = S1 -+ -+ CALL A -+ -+ END -diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f -new file mode 100644 -index 00000000000..26cd59f9090 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f -@@ -0,0 +1,57 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-sequence" } -+! -+! Test add default SEQUENCE attribute derived types appearing in -+! COMMON blocks and EQUIVALENCE statements. -+! -+! Contributed by Francisco Redondo Marchena -+! Modified by Mark Eggleston -+! -+ MODULE SEQ -+ TYPE STRUCT1 -+ INTEGER*4 ID -+ INTEGER*4 TYPE -+ INTEGER*8 DEFVAL -+ CHARACTER*(4) NAME -+ LOGICAL*1 NIL -+ END TYPE STRUCT1 -+ END MODULE -+ -+ SUBROUTINE A -+ USE SEQ -+ TYPE (STRUCT1) S ! { dg-error "Derived type variable" } -+ COMMON /BLOCK1/ S -+ IF (S%ID.NE.5) STOP 1 -+ IF (S%TYPE.NE.1000) STOP 2 -+ IF (S%DEFVAL.NE.-99) STOP 3 -+ IF (S%NAME.NE."JANE") STOP 4 -+ IF (S%NIL.NEQV..FALSE.) STOP 5 -+ END SUBROUTINE -+ -+ PROGRAM sequence_att_common -+ USE SEQ -+ IMPLICIT NONE -+ TYPE (STRUCT1) S1 -+ TYPE (STRUCT1) S2 -+ TYPE (STRUCT1) S3 ! { dg-error "Derived type variable" } -+ -+ EQUIVALENCE (S1,S2) ! { dg-error "Derived type variable" } -+ COMMON /BLOCK1/ S3 -+ -+ S1%ID = 5 -+ S1%TYPE = 1000 -+ S1%DEFVAL = -99 -+ S1%NAME = "JANE" -+ S1%NIL = .FALSE. -+ -+ IF (S2%ID.NE.5) STOP 1 -+ IF (S2%TYPE.NE.1000) STOP 2 -+ IF (S2%DEFVAL.NE.-99) STOP 3 -+ IF (S2%NAME.NE."JANE") STOP 4 -+ IF (S2%NIL.NEQV..FALSE.) STOP 5 -+ -+ S3 = S1 -+ -+ CALL A -+ -+ END --- -2.27.0 - diff --git a/gcc12-ifcvt-revert.patch b/gcc12-ifcvt-revert.patch deleted file mode 100644 index dd13271724a36f4b00982546c0db8398e9f0d5a3..0000000000000000000000000000000000000000 --- a/gcc12-ifcvt-revert.patch +++ /dev/null @@ -1,1141 +0,0 @@ -Revert r12-674{3,4,5,6,7,8,9} and r12-7114, as there are several PRs reported -against those changes still unresolved. - ---- gcc/ifcvt.cc -+++ gcc/ifcvt.cc -@@ -3391,11 +3391,7 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - rtx cond = noce_get_condition (jump, &cond_earliest, false); - - rtx cc_cmp = cond_exec_get_condition (jump); -- if (cc_cmp) -- cc_cmp = copy_rtx (cc_cmp); - rtx rev_cc_cmp = cond_exec_get_condition (jump, /* get_reversed */ true); -- if (rev_cc_cmp) -- rev_cc_cmp = copy_rtx (rev_cc_cmp); - - rtx_insn *insn; - int count = 0; -@@ -3519,7 +3515,6 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - unsigned cost1 = 0, cost2 = 0; - rtx_insn *seq, *seq1, *seq2; - rtx temp_dest = NULL_RTX, temp_dest1 = NULL_RTX, temp_dest2 = NULL_RTX; -- bool read_comparison = false; - - seq1 = try_emit_cmove_seq (if_info, temp, cond, - new_val, old_val, need_cmov, -@@ -3529,41 +3524,10 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - as well. This allows the backend to emit a cmov directly without - creating an additional compare for each. If successful, costing - is easier and this sequence is usually preferred. */ -- seq2 = try_emit_cmove_seq (if_info, temp, cond, -+ seq2 = try_emit_cmove_seq (if_info, target, cond, - new_val, old_val, need_cmov, - &cost2, &temp_dest2, cc_cmp, rev_cc_cmp); - -- /* The backend might have created a sequence that uses the -- condition. Check this. */ -- rtx_insn *walk = seq2; -- while (walk) -- { -- rtx set = single_set (walk); -- -- if (!set || !SET_SRC (set)) -- { -- walk = NEXT_INSN (walk); -- continue; -- } -- -- rtx src = SET_SRC (set); -- -- if (XEXP (set, 1) && GET_CODE (XEXP (set, 1)) == IF_THEN_ELSE) -- ; /* We assume that this is the cmove created by the backend that -- naturally uses the condition. Therefore we ignore it. */ -- else -- { -- if (reg_mentioned_p (XEXP (cond, 0), src) -- || reg_mentioned_p (XEXP (cond, 1), src)) -- { -- read_comparison = true; -- break; -- } -- } -- -- walk = NEXT_INSN (walk); -- } -- - /* Check which version is less expensive. */ - if (seq1 != NULL_RTX && (cost1 <= cost2 || seq2 == NULL_RTX)) - { -@@ -3576,8 +3540,6 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - { - seq = seq2; - temp_dest = temp_dest2; -- if (!second_try && read_comparison) -- *last_needs_comparison = count; - } - else - { -@@ -3596,12 +3558,6 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - unmodified_insns->safe_push (insn); - } - -- /* Even if we did not actually need the comparison, we want to make sure -- to try a second time in order to get rid of the temporaries. */ -- if (*last_needs_comparison == -1) -- *last_needs_comparison = 0; -- -- - return true; - } - ---- gcc/config/rs6000/rs6000.cc -+++ gcc/config/rs6000/rs6000.cc -@@ -16373,10 +16373,10 @@ rs6000_emit_minmax (rtx dest, enum rtx_code code, rtx op0, rtx op1) - c = GEU; - - if (code == SMAX || code == UMAX) -- target = emit_conditional_move (dest, { c, op0, op1, mode }, -+ target = emit_conditional_move (dest, c, op0, op1, mode, - op0, op1, mode, 0); - else -- target = emit_conditional_move (dest, { c, op0, op1, mode }, -+ target = emit_conditional_move (dest, c, op0, op1, mode, - op1, op0, mode, 0); - gcc_assert (target); - if (target != dest) -@@ -22769,7 +22769,7 @@ rs6000_emit_swsqrt (rtx dst, rtx src, bool recip) - - if (mode == SFmode) - { -- rtx target = emit_conditional_move (e, { GT, src, zero, mode }, -+ rtx target = emit_conditional_move (e, GT, src, zero, mode, - e, zero, mode, 0); - if (target != e) - emit_move_insn (e, target); ---- gcc/expmed.cc -+++ gcc/expmed.cc -@@ -4124,8 +4124,8 @@ expand_sdiv_pow2 (scalar_int_mode mode, rtx op0, HOST_WIDE_INT d) - temp = force_reg (mode, temp); - - /* Construct "temp2 = (temp2 < 0) ? temp : temp2". */ -- temp2 = emit_conditional_move (temp2, { LT, temp2, const0_rtx, mode }, -- temp, temp2, mode, 0); -+ temp2 = emit_conditional_move (temp2, LT, temp2, const0_rtx, -+ mode, temp, temp2, mode, 0); - if (temp2) - { - rtx_insn *seq = get_insns (); -@@ -6127,10 +6127,10 @@ emit_store_flag (rtx target, enum rtx_code code, rtx op0, rtx op1, - return 0; - - if (and_them) -- tem = emit_conditional_move (target, { code, op0, op1, mode }, -+ tem = emit_conditional_move (target, code, op0, op1, mode, - tem, const0_rtx, GET_MODE (tem), 0); - else -- tem = emit_conditional_move (target, { code, op0, op1, mode }, -+ tem = emit_conditional_move (target, code, op0, op1, mode, - trueval, tem, GET_MODE (tem), 0); - - if (tem == 0) ---- gcc/expr.cc -+++ gcc/expr.cc -@@ -8824,9 +8824,8 @@ expand_cond_expr_using_cmove (tree treeop0 ATTRIBUTE_UNUSED, - op2 = gen_lowpart (mode, op2); - - /* Try to emit the conditional move. */ -- insn = emit_conditional_move (temp, -- { comparison_code, op00, op01, -- comparison_mode }, -+ insn = emit_conditional_move (temp, comparison_code, -+ op00, op01, comparison_mode, - op1, op2, mode, - unsignedp); - -@@ -9717,9 +9716,8 @@ expand_expr_real_2 (sepops ops, rtx target, machine_mode tmode, - start_sequence (); - - /* Try to emit the conditional move. */ -- insn = emit_conditional_move (target, -- { comparison_code, -- op0, cmpop1, mode }, -+ insn = emit_conditional_move (target, comparison_code, -+ op0, cmpop1, mode, - op0, op1, mode, - unsignedp); - ---- gcc/ifcvt.cc -+++ gcc/ifcvt.cc -@@ -83,7 +83,7 @@ static rtx_insn *last_active_insn (basic_block, int); - static rtx_insn *find_active_insn_before (basic_block, rtx_insn *); - static rtx_insn *find_active_insn_after (basic_block, rtx_insn *); - static basic_block block_fallthru (basic_block); --static rtx cond_exec_get_condition (rtx_insn *, bool); -+static rtx cond_exec_get_condition (rtx_insn *); - static rtx noce_get_condition (rtx_insn *, rtx_insn **, bool); - static int noce_operand_ok (const_rtx); - static void merge_if_block (ce_if_block *); -@@ -98,14 +98,6 @@ static int dead_or_predicable (basic_block, basic_block, basic_block, - edge, int); - static void noce_emit_move_insn (rtx, rtx); - static rtx_insn *block_has_only_trap (basic_block); --static void need_cmov_or_rewire (basic_block, hash_set *, -- hash_map *); --static bool noce_convert_multiple_sets_1 (struct noce_if_info *, -- hash_set *, -- hash_map *, -- auto_vec *, -- auto_vec *, -- auto_vec *, int *); - - /* Count the number of non-jump active insns in BB. */ - -@@ -433,7 +425,7 @@ cond_exec_process_insns (ce_if_block *ce_info ATTRIBUTE_UNUSED, - /* Return the condition for a jump. Do not do any special processing. */ - - static rtx --cond_exec_get_condition (rtx_insn *jump, bool get_reversed = false) -+cond_exec_get_condition (rtx_insn *jump) - { - rtx test_if, cond; - -@@ -445,10 +437,8 @@ cond_exec_get_condition (rtx_insn *jump, bool get_reversed = false) - - /* If this branches to JUMP_LABEL when the condition is false, - reverse the condition. */ -- if (get_reversed -- || (GET_CODE (XEXP (test_if, 2)) == LABEL_REF -- && label_ref_label (XEXP (test_if, 2)) -- == JUMP_LABEL (jump))) -+ if (GET_CODE (XEXP (test_if, 2)) == LABEL_REF -+ && label_ref_label (XEXP (test_if, 2)) == JUMP_LABEL (jump)) - { - enum rtx_code rev = reversed_comparison_code (cond, jump); - if (rev == UNKNOWN) -@@ -780,7 +770,7 @@ static int noce_try_addcc (struct noce_if_info *); - static int noce_try_store_flag_constants (struct noce_if_info *); - static int noce_try_store_flag_mask (struct noce_if_info *); - static rtx noce_emit_cmove (struct noce_if_info *, rtx, enum rtx_code, rtx, -- rtx, rtx, rtx, rtx = NULL, rtx = NULL); -+ rtx, rtx, rtx); - static int noce_try_cmove (struct noce_if_info *); - static int noce_try_cmove_arith (struct noce_if_info *); - static rtx noce_get_alt_condition (struct noce_if_info *, rtx, rtx_insn **); -@@ -1719,8 +1709,7 @@ noce_try_store_flag_mask (struct noce_if_info *if_info) - - static rtx - noce_emit_cmove (struct noce_if_info *if_info, rtx x, enum rtx_code code, -- rtx cmp_a, rtx cmp_b, rtx vfalse, rtx vtrue, rtx cc_cmp, -- rtx rev_cc_cmp) -+ rtx cmp_a, rtx cmp_b, rtx vfalse, rtx vtrue) - { - rtx target ATTRIBUTE_UNUSED; - int unsignedp ATTRIBUTE_UNUSED; -@@ -1752,30 +1741,23 @@ noce_emit_cmove (struct noce_if_info *if_info, rtx x, enum rtx_code code, - end_sequence (); - } - -- unsignedp = (code == LTU || code == GEU -- || code == LEU || code == GTU); -- -- if (cc_cmp != NULL_RTX && rev_cc_cmp != NULL_RTX) -- target = emit_conditional_move (x, cc_cmp, rev_cc_cmp, -- vtrue, vfalse, GET_MODE (x)); -- else -+ /* Don't even try if the comparison operands are weird -+ except that the target supports cbranchcc4. */ -+ if (! general_operand (cmp_a, GET_MODE (cmp_a)) -+ || ! general_operand (cmp_b, GET_MODE (cmp_b))) - { -- /* Don't even try if the comparison operands are weird -- except that the target supports cbranchcc4. */ -- if (! general_operand (cmp_a, GET_MODE (cmp_a)) -- || ! general_operand (cmp_b, GET_MODE (cmp_b))) -- { -- if (!have_cbranchcc4 -- || GET_MODE_CLASS (GET_MODE (cmp_a)) != MODE_CC -- || cmp_b != const0_rtx) -- return NULL_RTX; -- } -- -- target = emit_conditional_move (x, { code, cmp_a, cmp_b, VOIDmode }, -- vtrue, vfalse, GET_MODE (x), -- unsignedp); -+ if (!have_cbranchcc4 -+ || GET_MODE_CLASS (GET_MODE (cmp_a)) != MODE_CC -+ || cmp_b != const0_rtx) -+ return NULL_RTX; - } - -+ unsignedp = (code == LTU || code == GEU -+ || code == LEU || code == GTU); -+ -+ target = emit_conditional_move (x, code, cmp_a, cmp_b, VOIDmode, -+ vtrue, vfalse, GET_MODE (x), -+ unsignedp); - if (target) - return target; - -@@ -1811,9 +1793,8 @@ noce_emit_cmove (struct noce_if_info *if_info, rtx x, enum rtx_code code, - - promoted_target = gen_reg_rtx (GET_MODE (reg_vtrue)); - -- target = emit_conditional_move (promoted_target, -- { code, cmp_a, cmp_b, VOIDmode }, -- reg_vtrue, reg_vfalse, -+ target = emit_conditional_move (promoted_target, code, cmp_a, cmp_b, -+ VOIDmode, reg_vtrue, reg_vfalse, - GET_MODE (reg_vtrue), unsignedp); - /* Nope, couldn't do it in that mode either. */ - if (!target) -@@ -3160,50 +3141,6 @@ bb_valid_for_noce_process_p (basic_block test_bb, rtx cond, - return false; - } - --/* Helper function to emit a cmov sequence encapsulated in -- start_sequence () and end_sequence (). If NEED_CMOV is true -- we call noce_emit_cmove to create a cmove sequence. Otherwise emit -- a simple move. If successful, store the first instruction of the -- sequence in TEMP_DEST and the sequence costs in SEQ_COST. */ -- --static rtx_insn* --try_emit_cmove_seq (struct noce_if_info *if_info, rtx temp, -- rtx cond, rtx new_val, rtx old_val, bool need_cmov, -- unsigned *cost, rtx *temp_dest, -- rtx cc_cmp = NULL, rtx rev_cc_cmp = NULL) --{ -- rtx_insn *seq = NULL; -- *cost = 0; -- -- rtx x = XEXP (cond, 0); -- rtx y = XEXP (cond, 1); -- rtx_code cond_code = GET_CODE (cond); -- -- start_sequence (); -- -- if (need_cmov) -- *temp_dest = noce_emit_cmove (if_info, temp, cond_code, -- x, y, new_val, old_val, cc_cmp, rev_cc_cmp); -- else -- { -- *temp_dest = temp; -- if (if_info->then_else_reversed) -- noce_emit_move_insn (temp, old_val); -- else -- noce_emit_move_insn (temp, new_val); -- } -- -- if (*temp_dest != NULL_RTX) -- { -- seq = get_insns (); -- *cost = seq_cost (seq, if_info->speed_p); -- } -- -- end_sequence (); -- -- return seq; --} -- - /* We have something like: - - if (x > y) -@@ -3261,6 +3198,7 @@ noce_convert_multiple_sets (struct noce_if_info *if_info) - rtx cond = noce_get_condition (jump, &cond_earliest, false); - rtx x = XEXP (cond, 0); - rtx y = XEXP (cond, 1); -+ rtx_code cond_code = GET_CODE (cond); - - /* The true targets for a conditional move. */ - auto_vec targets; -@@ -3269,139 +3207,8 @@ noce_convert_multiple_sets (struct noce_if_info *if_info) - auto_vec temporaries; - /* The insns we've emitted. */ - auto_vec unmodified_insns; -- -- hash_set need_no_cmov; -- hash_map rewired_src; -- -- need_cmov_or_rewire (then_bb, &need_no_cmov, &rewired_src); -- -- int last_needs_comparison = -1; -- -- bool ok = noce_convert_multiple_sets_1 -- (if_info, &need_no_cmov, &rewired_src, &targets, &temporaries, -- &unmodified_insns, &last_needs_comparison); -- if (!ok) -- return false; -- -- /* If there are insns that overwrite part of the initial -- comparison, we can still omit creating temporaries for -- the last of them. -- As the second try will always create a less expensive, -- valid sequence, we do not need to compare and can discard -- the first one. */ -- if (last_needs_comparison != -1) -- { -- end_sequence (); -- start_sequence (); -- ok = noce_convert_multiple_sets_1 -- (if_info, &need_no_cmov, &rewired_src, &targets, &temporaries, -- &unmodified_insns, &last_needs_comparison); -- /* Actually we should not fail anymore if we reached here, -- but better still check. */ -- if (!ok) -- return false; -- } -- -- /* We must have seen some sort of insn to insert, otherwise we were -- given an empty BB to convert, and we can't handle that. */ -- gcc_assert (!unmodified_insns.is_empty ()); -- -- /* Now fixup the assignments. */ -- for (unsigned i = 0; i < targets.length (); i++) -- if (targets[i] != temporaries[i]) -- noce_emit_move_insn (targets[i], temporaries[i]); -- -- /* Actually emit the sequence if it isn't too expensive. */ -- rtx_insn *seq = get_insns (); -- -- if (!targetm.noce_conversion_profitable_p (seq, if_info)) -- { -- end_sequence (); -- return FALSE; -- } -- -- for (insn = seq; insn; insn = NEXT_INSN (insn)) -- set_used_flags (insn); -- -- /* Mark all our temporaries and targets as used. */ -- for (unsigned i = 0; i < targets.length (); i++) -- { -- set_used_flags (temporaries[i]); -- set_used_flags (targets[i]); -- } -- -- set_used_flags (cond); -- set_used_flags (x); -- set_used_flags (y); -- -- unshare_all_rtl_in_chain (seq); -- end_sequence (); -- -- if (!seq) -- return FALSE; -- -- for (insn = seq; insn; insn = NEXT_INSN (insn)) -- if (JUMP_P (insn) -- || recog_memoized (insn) == -1) -- return FALSE; -- -- emit_insn_before_setloc (seq, if_info->jump, -- INSN_LOCATION (unmodified_insns.last ())); -- -- /* Clean up THEN_BB and the edges in and out of it. */ -- remove_edge (find_edge (test_bb, join_bb)); -- remove_edge (find_edge (then_bb, join_bb)); -- redirect_edge_and_branch_force (single_succ_edge (test_bb), join_bb); -- delete_basic_block (then_bb); -- num_true_changes++; -- -- /* Maybe merge blocks now the jump is simple enough. */ -- if (can_merge_blocks_p (test_bb, join_bb)) -- { -- merge_blocks (test_bb, join_bb); -- num_true_changes++; -- } -- -- num_updated_if_blocks++; -- if_info->transform_name = "noce_convert_multiple_sets"; -- return TRUE; --} -- --/* This goes through all relevant insns of IF_INFO->then_bb and tries to -- create conditional moves. In case a simple move sufficis the insn -- should be listed in NEED_NO_CMOV. The rewired-src cases should be -- specified via REWIRED_SRC. TARGETS, TEMPORARIES and UNMODIFIED_INSNS -- are specified and used in noce_convert_multiple_sets and should be passed -- to this function.. */ -- --static bool --noce_convert_multiple_sets_1 (struct noce_if_info *if_info, -- hash_set *need_no_cmov, -- hash_map *rewired_src, -- auto_vec *targets, -- auto_vec *temporaries, -- auto_vec *unmodified_insns, -- int *last_needs_comparison) --{ -- basic_block then_bb = if_info->then_bb; -- rtx_insn *jump = if_info->jump; -- rtx_insn *cond_earliest; -- -- /* Decompose the condition attached to the jump. */ -- rtx cond = noce_get_condition (jump, &cond_earliest, false); -- -- rtx cc_cmp = cond_exec_get_condition (jump); -- rtx rev_cc_cmp = cond_exec_get_condition (jump, /* get_reversed */ true); -- -- rtx_insn *insn; - int count = 0; - -- targets->truncate (0); -- temporaries->truncate (0); -- unmodified_insns->truncate (0); -- -- bool second_try = *last_needs_comparison != -1; -- - FOR_BB_INSNS (then_bb, insn) - { - /* Skip over non-insns. */ -@@ -3412,53 +3219,26 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - gcc_checking_assert (set); - - rtx target = SET_DEST (set); -- rtx temp; -- -+ rtx temp = gen_reg_rtx (GET_MODE (target)); - rtx new_val = SET_SRC (set); -- if (int *ii = rewired_src->get (insn)) -- new_val = simplify_replace_rtx (new_val, (*targets)[*ii], -- (*temporaries)[*ii]); - rtx old_val = target; - -- /* As we are transforming -- if (x > y) -- { -- a = b; -- c = d; -- } -- into -- a = (x > y) ... -- c = (x > y) ... -- -- we potentially check x > y before every set. -- Even though the check might be removed by subsequent passes, this means -- that we cannot transform -- if (x > y) -- { -- x = y; -- ... -- } -- into -- x = (x > y) ... -- ... -- since this would invalidate x and the following to-be-removed checks. -- Therefore we introduce a temporary every time we are about to -- overwrite a variable used in the check. Costing of a sequence with -- these is going to be inaccurate so only use temporaries when -- needed. -- -- If performing a second try, we know how many insns require a -- temporary. For the last of these, we can omit creating one. */ -- if (reg_overlap_mentioned_p (target, cond) -- && (!second_try || count < *last_needs_comparison)) -- temp = gen_reg_rtx (GET_MODE (target)); -- else -- temp = target; -- -- /* We have identified swap-style idioms before. A normal -- set will need to be a cmov while the first instruction of a swap-style -- idiom can be a regular move. This helps with costing. */ -- bool need_cmov = !need_no_cmov->contains (insn); -+ /* If we were supposed to read from an earlier write in this block, -+ we've changed the register allocation. Rewire the read. While -+ we are looking, also try to catch a swap idiom. */ -+ for (int i = count - 1; i >= 0; --i) -+ if (reg_overlap_mentioned_p (new_val, targets[i])) -+ { -+ /* Catch a "swap" style idiom. */ -+ if (find_reg_note (insn, REG_DEAD, new_val) != NULL_RTX) -+ /* The write to targets[i] is only live until the read -+ here. As the condition codes match, we can propagate -+ the set to here. */ -+ new_val = SET_SRC (single_set (unmodified_insns[i])); -+ else -+ new_val = temporaries[i]; -+ break; -+ } - - /* If we had a non-canonical conditional jump (i.e. one where - the fallthrough is to the "else" case) we need to reverse -@@ -3478,9 +3258,7 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - we'll end up trying to emit r4:HI = cond ? (r1:SI) : (r3:HI). - Wrap the two cmove operands into subregs if appropriate to prevent - that. */ -- -- if (!CONSTANT_P (new_val) -- && GET_MODE (new_val) != GET_MODE (temp)) -+ if (GET_MODE (new_val) != GET_MODE (temp)) - { - machine_mode src_mode = GET_MODE (new_val); - machine_mode dst_mode = GET_MODE (temp); -@@ -3491,8 +3269,7 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - } - new_val = lowpart_subreg (dst_mode, new_val, src_mode); - } -- if (!CONSTANT_P (old_val) -- && GET_MODE (old_val) != GET_MODE (temp)) -+ if (GET_MODE (old_val) != GET_MODE (temp)) - { - machine_mode src_mode = GET_MODE (old_val); - machine_mode dst_mode = GET_MODE (temp); -@@ -3504,80 +3281,101 @@ noce_convert_multiple_sets_1 (struct noce_if_info *if_info, - old_val = lowpart_subreg (dst_mode, old_val, src_mode); - } - -- /* Try emitting a conditional move passing the backend the -- canonicalized comparison. The backend is then able to -- recognize expressions like -- -- if (x > y) -- y = x; -- -- as min/max and emit an insn, accordingly. */ -- unsigned cost1 = 0, cost2 = 0; -- rtx_insn *seq, *seq1, *seq2; -- rtx temp_dest = NULL_RTX, temp_dest1 = NULL_RTX, temp_dest2 = NULL_RTX; -+ /* Actually emit the conditional move. */ -+ rtx temp_dest = noce_emit_cmove (if_info, temp, cond_code, -+ x, y, new_val, old_val); - -- seq1 = try_emit_cmove_seq (if_info, temp, cond, -- new_val, old_val, need_cmov, -- &cost1, &temp_dest1); -- -- /* Here, we try to pass the backend a non-canonicalized cc comparison -- as well. This allows the backend to emit a cmov directly without -- creating an additional compare for each. If successful, costing -- is easier and this sequence is usually preferred. */ -- seq2 = try_emit_cmove_seq (if_info, target, cond, -- new_val, old_val, need_cmov, -- &cost2, &temp_dest2, cc_cmp, rev_cc_cmp); -- -- /* Check which version is less expensive. */ -- if (seq1 != NULL_RTX && (cost1 <= cost2 || seq2 == NULL_RTX)) -- { -- seq = seq1; -- temp_dest = temp_dest1; -- if (!second_try) -- *last_needs_comparison = count; -- } -- else if (seq2 != NULL_RTX) -- { -- seq = seq2; -- temp_dest = temp_dest2; -- } -- else -+ /* If we failed to expand the conditional move, drop out and don't -+ try to continue. */ -+ if (temp_dest == NULL_RTX) - { -- /* Nothing worked, bail out. */ - end_sequence (); - return FALSE; - } - -- /* End the sub sequence and emit to the main sequence. */ -- emit_insn (seq); -- - /* Bookkeeping. */ - count++; -- targets->safe_push (target); -- temporaries->safe_push (temp_dest); -- unmodified_insns->safe_push (insn); -+ targets.safe_push (target); -+ temporaries.safe_push (temp_dest); -+ unmodified_insns.safe_push (insn); - } - -- return true; --} -+ /* We must have seen some sort of insn to insert, otherwise we were -+ given an empty BB to convert, and we can't handle that. */ -+ gcc_assert (!unmodified_insns.is_empty ()); -+ -+ /* Now fixup the assignments. */ -+ for (int i = 0; i < count; i++) -+ noce_emit_move_insn (targets[i], temporaries[i]); -+ -+ /* Actually emit the sequence if it isn't too expensive. */ -+ rtx_insn *seq = get_insns (); -+ -+ if (!targetm.noce_conversion_profitable_p (seq, if_info)) -+ { -+ end_sequence (); -+ return FALSE; -+ } -+ -+ for (insn = seq; insn; insn = NEXT_INSN (insn)) -+ set_used_flags (insn); -+ -+ /* Mark all our temporaries and targets as used. */ -+ for (int i = 0; i < count; i++) -+ { -+ set_used_flags (temporaries[i]); -+ set_used_flags (targets[i]); -+ } - -+ set_used_flags (cond); -+ set_used_flags (x); -+ set_used_flags (y); - -+ unshare_all_rtl_in_chain (seq); -+ end_sequence (); -+ -+ if (!seq) -+ return FALSE; -+ -+ for (insn = seq; insn; insn = NEXT_INSN (insn)) -+ if (JUMP_P (insn) -+ || recog_memoized (insn) == -1) -+ return FALSE; -+ -+ emit_insn_before_setloc (seq, if_info->jump, -+ INSN_LOCATION (unmodified_insns.last ())); -+ -+ /* Clean up THEN_BB and the edges in and out of it. */ -+ remove_edge (find_edge (test_bb, join_bb)); -+ remove_edge (find_edge (then_bb, join_bb)); -+ redirect_edge_and_branch_force (single_succ_edge (test_bb), join_bb); -+ delete_basic_block (then_bb); -+ num_true_changes++; -+ -+ /* Maybe merge blocks now the jump is simple enough. */ -+ if (can_merge_blocks_p (test_bb, join_bb)) -+ { -+ merge_blocks (test_bb, join_bb); -+ num_true_changes++; -+ } -+ -+ num_updated_if_blocks++; -+ if_info->transform_name = "noce_convert_multiple_sets"; -+ return TRUE; -+} - - /* Return true iff basic block TEST_BB is comprised of only - (SET (REG) (REG)) insns suitable for conversion to a series - of conditional moves. Also check that we have more than one set - (other routines can handle a single set better than we would), and -- fewer than PARAM_MAX_RTL_IF_CONVERSION_INSNS sets. While going -- through the insns store the sum of their potential costs in COST. */ -+ fewer than PARAM_MAX_RTL_IF_CONVERSION_INSNS sets. */ - - static bool --bb_ok_for_noce_convert_multiple_sets (basic_block test_bb, unsigned *cost) -+bb_ok_for_noce_convert_multiple_sets (basic_block test_bb) - { - rtx_insn *insn; - unsigned count = 0; - unsigned param = param_max_rtl_if_conversion_insns; -- bool speed_p = optimize_bb_for_speed_p (test_bb); -- unsigned potential_cost = 0; - - FOR_BB_INSNS (test_bb, insn) - { -@@ -3600,9 +3398,9 @@ bb_ok_for_noce_convert_multiple_sets (basic_block test_bb, unsigned *cost) - if (!REG_P (dest)) - return false; - -- if (!((REG_P (src) || CONSTANT_P (src)) -- || (GET_CODE (src) == SUBREG && REG_P (SUBREG_REG (src)) -- && subreg_lowpart_p (src)))) -+ if (!(REG_P (src) -+ || (GET_CODE (src) == SUBREG && REG_P (SUBREG_REG (src)) -+ && subreg_lowpart_p (src)))) - return false; - - /* Destination must be appropriate for a conditional write. */ -@@ -3613,13 +3411,9 @@ bb_ok_for_noce_convert_multiple_sets (basic_block test_bb, unsigned *cost) - if (!can_conditionally_move_p (GET_MODE (dest))) - return false; - -- potential_cost += insn_cost (insn, speed_p); -- - count++; - } - -- *cost += potential_cost; -- - /* If we would only put out one conditional move, the other strategies - this pass tries are better optimized and will be more appropriate. - Some targets want to strictly limit the number of conditional moves -@@ -3667,24 +3461,11 @@ noce_process_if_block (struct noce_if_info *if_info) - to calculate a value for x. - ??? For future expansion, further expand the "multiple X" rules. */ - -- /* First look for multiple SETS. The original costs already include -- a base cost of COSTS_N_INSNS (2): one instruction for the compare -- (which we will be needing either way) and one instruction for the -- branch. When comparing costs we want to use the branch instruction -- cost and the sets vs. the cmovs generated here. Therefore subtract -- the costs of the compare before checking. -- ??? Actually, instead of the branch instruction costs we might want -- to use COSTS_N_INSNS (BRANCH_COST ()) as in other places. */ -- -- unsigned potential_cost = if_info->original_cost - COSTS_N_INSNS (1); -- unsigned old_cost = if_info->original_cost; -+ /* First look for multiple SETS. */ - if (!else_bb - && HAVE_conditional_move -- && bb_ok_for_noce_convert_multiple_sets (then_bb, &potential_cost)) -+ && bb_ok_for_noce_convert_multiple_sets (then_bb)) - { -- /* Temporarily set the original costs to what we estimated so -- we can determine if the transformation is worth it. */ -- if_info->original_cost = potential_cost; - if (noce_convert_multiple_sets (if_info)) - { - if (dump_file && if_info->transform_name) -@@ -3692,9 +3473,6 @@ noce_process_if_block (struct noce_if_info *if_info) - if_info->transform_name); - return TRUE; - } -- -- /* Restore the original costs. */ -- if_info->original_cost = old_cost; - } - - bool speed_p = optimize_bb_for_speed_p (test_bb); -@@ -4036,89 +3814,6 @@ check_cond_move_block (basic_block bb, - return TRUE; - } - --/* Find local swap-style idioms in BB and mark the first insn (1) -- that is only a temporary as not needing a conditional move as -- it is going to be dead afterwards anyway. -- -- (1) int tmp = a; -- a = b; -- b = tmp; -- -- ifcvt -- --> -- -- tmp = a; -- a = cond ? b : a_old; -- b = cond ? tmp : b_old; -- -- Additionally, store the index of insns like (2) when a subsequent -- SET reads from their destination. -- -- (2) int c = a; -- int d = c; -- -- ifcvt -- --> -- -- c = cond ? a : c_old; -- d = cond ? d : c; // Need to use c rather than c_old here. --*/ -- --static void --need_cmov_or_rewire (basic_block bb, -- hash_set *need_no_cmov, -- hash_map *rewired_src) --{ -- rtx_insn *insn; -- int count = 0; -- auto_vec insns; -- auto_vec dests; -- -- /* Iterate over all SETs, storing the destinations -- in DEST. -- - If we hit a SET that reads from a destination -- that we have seen before and the corresponding register -- is dead afterwards, the register does not need to be -- moved conditionally. -- - If we encounter a previously changed register, -- rewire the read to the original source. */ -- FOR_BB_INSNS (bb, insn) -- { -- rtx set, src, dest; -- -- if (!active_insn_p (insn)) -- continue; -- -- set = single_set (insn); -- if (set == NULL_RTX) -- continue; -- -- src = SET_SRC (set); -- if (SUBREG_P (src)) -- src = SUBREG_REG (src); -- dest = SET_DEST (set); -- -- /* Check if the current SET's source is the same -- as any previously seen destination. -- This is quadratic but the number of insns in BB -- is bounded by PARAM_MAX_RTL_IF_CONVERSION_INSNS. */ -- if (REG_P (src)) -- for (int i = count - 1; i >= 0; --i) -- if (reg_overlap_mentioned_p (src, dests[i])) -- { -- if (find_reg_note (insn, REG_DEAD, src) != NULL_RTX) -- need_no_cmov->add (insns[i]); -- else -- rewired_src->put (insn, i); -- } -- -- insns.safe_push (insn); -- dests.safe_push (dest); -- -- count++; -- } --} -- - /* Given a basic block BB suitable for conditional move conversion, - a condition COND, and pointer maps THEN_VALS and ELSE_VALS containing - the register values depending on COND, emit the insns in the block as ---- gcc/optabs.cc -+++ gcc/optabs.cc -@@ -52,8 +52,6 @@ static void prepare_float_lib_cmp (rtx, rtx, enum rtx_code, rtx *, - static rtx expand_unop_direct (machine_mode, optab, rtx, rtx, int); - static void emit_libcall_block_1 (rtx_insn *, rtx, rtx, rtx, bool); - --static rtx emit_conditional_move_1 (rtx, rtx, rtx, rtx, machine_mode); -- - /* Debug facility for use in GDB. */ - void debug_optab_libfuncs (void); - -@@ -626,13 +624,12 @@ expand_doubleword_shift_condmove (scalar_int_mode op1_mode, optab binoptab, - - /* Select between them. Do the INTO half first because INTO_SUPERWORD - might be the current value of OUTOF_TARGET. */ -- if (!emit_conditional_move (into_target, { cmp_code, cmp1, cmp2, op1_mode }, -+ if (!emit_conditional_move (into_target, cmp_code, cmp1, cmp2, op1_mode, - into_target, into_superword, word_mode, false)) - return false; - - if (outof_target != 0) -- if (!emit_conditional_move (outof_target, -- { cmp_code, cmp1, cmp2, op1_mode }, -+ if (!emit_conditional_move (outof_target, cmp_code, cmp1, cmp2, op1_mode, - outof_target, outof_superword, - word_mode, false)) - return false; -@@ -4854,8 +4851,8 @@ emit_indirect_jump (rtx loc) - is not supported. */ - - rtx --emit_conditional_move (rtx target, struct rtx_comparison comp, -- rtx op2, rtx op3, -+emit_conditional_move (rtx target, enum rtx_code code, rtx op0, rtx op1, -+ machine_mode cmode, rtx op2, rtx op3, - machine_mode mode, int unsignedp) - { - rtx comparison; -@@ -4877,33 +4874,31 @@ emit_conditional_move (rtx target, struct rtx_comparison comp, - /* If one operand is constant, make it the second one. Only do this - if the other operand is not constant as well. */ - -- if (swap_commutative_operands_p (comp.op0, comp.op1)) -+ if (swap_commutative_operands_p (op0, op1)) - { -- std::swap (comp.op0, comp.op1); -- comp.code = swap_condition (comp.code); -+ std::swap (op0, op1); -+ code = swap_condition (code); - } - - /* get_condition will prefer to generate LT and GT even if the old - comparison was against zero, so undo that canonicalization here since - comparisons against zero are cheaper. */ -+ if (code == LT && op1 == const1_rtx) -+ code = LE, op1 = const0_rtx; -+ else if (code == GT && op1 == constm1_rtx) -+ code = GE, op1 = const0_rtx; - -- if (comp.code == LT && comp.op1 == const1_rtx) -- comp.code = LE, comp.op1 = const0_rtx; -- else if (comp.code == GT && comp.op1 == constm1_rtx) -- comp.code = GE, comp.op1 = const0_rtx; -- -- if (comp.mode == VOIDmode) -- comp.mode = GET_MODE (comp.op0); -+ if (cmode == VOIDmode) -+ cmode = GET_MODE (op0); - -- enum rtx_code orig_code = comp.code; -+ enum rtx_code orig_code = code; - bool swapped = false; - if (swap_commutative_operands_p (op2, op3) -- && ((reversed = -- reversed_comparison_code_parts (comp.code, comp.op0, comp.op1, NULL)) -- != UNKNOWN)) -+ && ((reversed = reversed_comparison_code_parts (code, op0, op1, NULL)) -+ != UNKNOWN)) - { - std::swap (op2, op3); -- comp.code = reversed; -+ code = reversed; - swapped = true; - } - -@@ -4920,10 +4915,8 @@ emit_conditional_move (rtx target, struct rtx_comparison comp, - - for (int pass = 0; ; pass++) - { -- comp.code = unsignedp ? unsigned_condition (comp.code) : comp.code; -- comparison = -- simplify_gen_relational (comp.code, VOIDmode, -- comp.mode, comp.op0, comp.op1); -+ code = unsignedp ? unsigned_condition (code) : code; -+ comparison = simplify_gen_relational (code, VOIDmode, cmode, op0, op1); - - /* We can get const0_rtx or const_true_rtx in some circumstances. Just - punt and let the caller figure out how best to deal with this -@@ -4934,16 +4927,24 @@ emit_conditional_move (rtx target, struct rtx_comparison comp, - save_pending_stack_adjust (&save); - last = get_last_insn (); - do_pending_stack_adjust (); -- machine_mode cmpmode = comp.mode; -+ machine_mode cmpmode = cmode; - prepare_cmp_insn (XEXP (comparison, 0), XEXP (comparison, 1), - GET_CODE (comparison), NULL_RTX, unsignedp, - OPTAB_WIDEN, &comparison, &cmpmode); - if (comparison) - { -- rtx res = emit_conditional_move_1 (target, comparison, -- op2, op3, mode); -- if (res != NULL_RTX) -- return res; -+ class expand_operand ops[4]; -+ -+ create_output_operand (&ops[0], target, mode); -+ create_fixed_operand (&ops[1], comparison); -+ create_input_operand (&ops[2], op2, mode); -+ create_input_operand (&ops[3], op3, mode); -+ if (maybe_expand_insn (icode, 4, ops)) -+ { -+ if (ops[0].value != target) -+ convert_move (target, ops[0].value, false); -+ return target; -+ } - } - delete_insns_since (last); - restore_pending_stack_adjust (&save); -@@ -4955,88 +4956,17 @@ emit_conditional_move (rtx target, struct rtx_comparison comp, - /* If the preferred op2/op3 order is not usable, retry with other - operand order, perhaps it will expand successfully. */ - if (swapped) -- comp.code = orig_code; -- else if ((reversed = -- reversed_comparison_code_parts (orig_code, comp.op0, comp.op1, -+ code = orig_code; -+ else if ((reversed = reversed_comparison_code_parts (orig_code, op0, op1, - NULL)) - != UNKNOWN) -- comp.code = reversed; -+ code = reversed; - else - return NULL_RTX; - std::swap (op2, op3); - } - } - --/* Helper function that, in addition to COMPARISON, also tries -- the reversed REV_COMPARISON with swapped OP2 and OP3. As opposed -- to when we pass the specific constituents of a comparison, no -- additional insns are emitted for it. It might still be necessary -- to emit more than one insn for the final conditional move, though. */ -- --rtx --emit_conditional_move (rtx target, rtx comparison, rtx rev_comparison, -- rtx op2, rtx op3, machine_mode mode) --{ -- rtx res = emit_conditional_move_1 (target, comparison, op2, op3, mode); -- -- if (res != NULL_RTX) -- return res; -- -- return emit_conditional_move_1 (target, rev_comparison, op3, op2, mode); --} -- --/* Helper for emitting a conditional move. */ -- --static rtx --emit_conditional_move_1 (rtx target, rtx comparison, -- rtx op2, rtx op3, machine_mode mode) --{ -- enum insn_code icode; -- -- if (comparison == NULL_RTX || !COMPARISON_P (comparison)) -- return NULL_RTX; -- -- /* If the two source operands are identical, that's just a move. -- As the comparison comes in non-canonicalized, we must make -- sure not to discard any possible side effects. If there are -- side effects, just let the target handle it. */ -- if (!side_effects_p (comparison) && rtx_equal_p (op2, op3)) -- { -- if (!target) -- target = gen_reg_rtx (mode); -- -- emit_move_insn (target, op3); -- return target; -- } -- -- if (mode == VOIDmode) -- mode = GET_MODE (op2); -- -- icode = direct_optab_handler (movcc_optab, mode); -- -- if (icode == CODE_FOR_nothing) -- return NULL_RTX; -- -- if (!target) -- target = gen_reg_rtx (mode); -- -- class expand_operand ops[4]; -- -- create_output_operand (&ops[0], target, mode); -- create_fixed_operand (&ops[1], comparison); -- create_input_operand (&ops[2], op2, mode); -- create_input_operand (&ops[3], op3, mode); -- -- if (maybe_expand_insn (icode, 4, ops)) -- { -- if (ops[0].value != target) -- convert_move (target, ops[0].value, false); -- return target; -- } -- -- return NULL_RTX; --} -- - - /* Emit a conditional negate or bitwise complement using the - negcc or notcc optabs if available. Return NULL_RTX if such operations ---- gcc/optabs.h -+++ gcc/optabs.h -@@ -279,8 +279,8 @@ extern void emit_indirect_jump (rtx); - #endif - - /* Emit a conditional move operation. */ --rtx emit_conditional_move (rtx, rtx_comparison, rtx, rtx, machine_mode, int); --rtx emit_conditional_move (rtx, rtx, rtx, rtx, rtx, machine_mode); -+rtx emit_conditional_move (rtx, enum rtx_code, rtx, rtx, machine_mode, -+ rtx, rtx, machine_mode, int); - - /* Emit a conditional negate or bitwise complement operation. */ - rtx emit_conditional_neg_or_complement (rtx, rtx_code, machine_mode, rtx, ---- gcc/rtl.h -+++ gcc/rtl.h -@@ -4604,16 +4604,7 @@ word_register_operation_p (const_rtx x) - return true; - } - } -- --/* Holds an rtx comparison to simplify passing many parameters pertaining to a -- single comparison. */ -- --struct rtx_comparison { -- rtx_code code; -- rtx op0, op1; -- machine_mode mode; --}; -- -+ - /* gtype-desc.cc. */ - extern void gt_ggc_mx (rtx &); - extern void gt_pch_nx (rtx &); diff --git a/gcc12-pr107468.patch b/gcc12-pr107468.patch new file mode 100644 index 0000000000000000000000000000000000000000..0949b116c253d68ed8acb131fefa32dfd8b28559 --- /dev/null +++ b/gcc12-pr107468.patch @@ -0,0 +1,124 @@ +libstdc++: Update from latest fast_float [PR107468] + +The following patch is a cherry-pick from +https://github.com/fastfloat/fast_float/pull/153 +to restrict fast_float Clinger's fast path to when rounding mode +is FE_TONEAREST. +Using std::fegetround showed in benchmarks too slow, so instead +it uses a check with 2 float additions and comparison to verify +if rounding is FE_TONEAREST. + +2022-11-20 Jakub Jelinek + + PR libstdc++/107468 + * src/c++17/fast_float/fast_float.h (detail::rounds_to_nearest): New + function, taken from https://github.com/fastfloat/fast_float/pull/153. + (from_chars_advanced): Only use Clinger's fast path if + detail::rounds_to_nearest(). + * testsuite/20_util/from_chars/pr107468.cc: New test. + +--- libstdc++-v3/src/c++17/fast_float/fast_float.h.jj 2022-04-28 15:56:18.315632888 +0200 ++++ libstdc++-v3/src/c++17/fast_float/fast_float.h 2022-11-20 18:53:49.570830249 +0100 +@@ -2842,6 +2842,48 @@ from_chars_result parse_infnan(const cha + return answer; + } + ++/** ++ * Returns true if the floating-pointing rounding mode is to 'nearest'. ++ * It is the default on most system. This function is meant to be inexpensive. ++ * Credit : @mwalcott3 ++ */ ++fastfloat_really_inline bool rounds_to_nearest() noexcept { ++ // See ++ // A fast function to check your floating-point rounding mode ++ // https://lemire.me/blog/2022/11/16/a-fast-function-to-check-your-floating-point-rounding-mode/ ++ // ++ // This function is meant to be equivalent to : ++ // prior: #include ++ // return fegetround() == FE_TONEAREST; ++ // However, it is expected to be much faster than the fegetround() ++ // function call. ++ // ++ // The volatile keywoard prevents the compiler from computing the function ++ // at compile-time. ++ // There might be other ways to prevent compile-time optimizations (e.g., asm). ++ // The value does not need to be std::numeric_limits::min(), any small ++ // value so that 1 + x should round to 1 would do (after accounting for excess ++ // precision, as in 387 instructions). ++ static volatile float fmin = std::numeric_limits::min(); ++ float fmini = fmin; // we copy it so that it gets loaded at most once. ++ // ++ // Explanation: ++ // Only when fegetround() == FE_TONEAREST do we have that ++ // fmin + 1.0f == 1.0f - fmin. ++ // ++ // FE_UPWARD: ++ // fmin + 1.0f > 1 ++ // 1.0f - fmin == 1 ++ // ++ // FE_DOWNWARD or FE_TOWARDZERO: ++ // fmin + 1.0f == 1 ++ // 1.0f - fmin < 1 ++ // ++ // Note: This may fail to be accurate if fast-math has been ++ // enabled, as rounding conventions may not apply. ++ return (fmini + 1.0f == 1.0f - fmini); ++} ++ + } // namespace detail + + template +@@ -2870,7 +2912,7 @@ from_chars_result from_chars_advanced(co + answer.ec = std::errc(); // be optimistic + answer.ptr = pns.lastmatch; + // Next is Clinger's fast path. +- if (binary_format::min_exponent_fast_path() <= pns.exponent && pns.exponent <= binary_format::max_exponent_fast_path() && pns.mantissa <=binary_format::max_mantissa_fast_path() && !pns.too_many_digits) { ++ if (binary_format::min_exponent_fast_path() <= pns.exponent && pns.exponent <= binary_format::max_exponent_fast_path() && pns.mantissa <=binary_format::max_mantissa_fast_path() && !pns.too_many_digits && detail::rounds_to_nearest()) { + value = T(pns.mantissa); + if (pns.exponent < 0) { value = value / binary_format::exact_power_of_ten(-pns.exponent); } + else { value = value * binary_format::exact_power_of_ten(pns.exponent); } +--- libstdc++-v3/testsuite/20_util/from_chars/pr107468.cc.jj ++++ libstdc++-v3/testsuite/20_util/from_chars/pr107468.cc +@@ -0,0 +1,42 @@ ++// Copyright (C) 2022 Free Software Foundation, Inc. ++// ++// This file is part of the GNU ISO C++ Library. This library is free ++// software; you can redistribute it and/or modify it under the ++// terms of the GNU General Public License as published by the ++// Free Software Foundation; either version 3, or (at your option) ++// any later version. ++ ++// This library is distributed in the hope that it will be useful, ++// but WITHOUT ANY WARRANTY; without even the implied warranty of ++// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++// GNU General Public License for more details. ++ ++// You should have received a copy of the GNU General Public License along ++// with this library; see the file COPYING3. If not see ++// . ++ ++// { dg-do run { target c++17 } } ++// { dg-add-options ieee } ++ ++#include ++#include ++#include ++#include ++ ++int ++main() ++{ ++ // FP from_char not available otherwise. ++#if __cpp_lib_to_chars >= 201611L \ ++ && _GLIBCXX_USE_C99_FENV_TR1 \ ++ && defined(FE_DOWNWARD) \ ++ && defined(_GLIBCXX_FLOAT_IS_IEEE_BINARY32) ++ // PR libstdc++/107468 ++ float f; ++ char buf[] = "3.355447e+07"; ++ std::fesetround(FE_DOWNWARD); ++ auto [ptr, ec] = std::from_chars(buf, buf + sizeof(buf) - 1, f, std::chars_format::scientific); ++ VERIFY( ec == std::errc() && ptr == buf + sizeof(buf) - 1 ); ++ VERIFY( f == 33554472.0f ); ++#endif ++} diff --git a/isl-0.18.tar.bz2 b/isl-0.18.tar.bz2 deleted file mode 100644 index 4c8296cb72a25bbb2ef698c729855dfe7dbfa10d..0000000000000000000000000000000000000000 Binary files a/isl-0.18.tar.bz2 and /dev/null differ diff --git a/isl-0.24.tar.bz2 b/isl-0.24.tar.bz2 new file mode 100644 index 0000000000000000000000000000000000000000..c44caf29f0c03471636c31182c93219a6a401f9b Binary files /dev/null and b/isl-0.24.tar.bz2 differ diff --git a/newlib-cygwin-50e2a63b04bdd018484605fbb954fd1bd5147fa0.tar.xz b/newlib-cygwin-a8526cb52bedabd4d6ba4b227a5185627f871aa1.tar.xz similarity index 46% rename from newlib-cygwin-50e2a63b04bdd018484605fbb954fd1bd5147fa0.tar.xz rename to newlib-cygwin-a8526cb52bedabd4d6ba4b227a5185627f871aa1.tar.xz index 38097b3a9dc937ec9d8772abe1923900a6f3b105..8dba9bc55923f175c2c405f0652f6a3a538bfb1b 100644 Binary files a/newlib-cygwin-50e2a63b04bdd018484605fbb954fd1bd5147fa0.tar.xz and b/newlib-cygwin-a8526cb52bedabd4d6ba4b227a5185627f871aa1.tar.xz differ diff --git a/nvptx-tools-472b6e78b3ba918d727698f79911360b7c808247.tar.xz b/nvptx-tools-472b6e78b3ba918d727698f79911360b7c808247.tar.xz new file mode 100644 index 0000000000000000000000000000000000000000..851da435b4ac6ff3e8b5c4ea39a7ad8b5a35ebd0 Binary files /dev/null and b/nvptx-tools-472b6e78b3ba918d727698f79911360b7c808247.tar.xz differ diff --git a/nvptx-tools-5f6f343a302d620b0868edab376c00b15741e39e.tar.xz b/nvptx-tools-5f6f343a302d620b0868edab376c00b15741e39e.tar.xz deleted file mode 100644 index 2740609a65eadb8407fcb8439f3a10d9daf7855f..0000000000000000000000000000000000000000 Binary files a/nvptx-tools-5f6f343a302d620b0868edab376c00b15741e39e.tar.xz and /dev/null differ