diff options
Diffstat (limited to 'gcc/testsuite')
395 files changed, 12295 insertions, 288 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9d72267b592..7f62d4b07db 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-05-13 Diego Novillo <dnovillo@redhat.com> + + Merge from tree-ssa-20020619-branch. See + ChangeLog.tree-ssa for details. + 2004-05-11 Ziemowit Laski <zlaski@apple.com> * g++.dg/ext/altivec-8.C: Use '-maltivec' instead of '-faltivec'; diff --git a/gcc/testsuite/ChangeLog.tree-ssa b/gcc/testsuite/ChangeLog.tree-ssa new file mode 100644 index 00000000000..03ccbb01ed2 --- /dev/null +++ b/gcc/testsuite/ChangeLog.tree-ssa @@ -0,0 +1,1204 @@ +2004-05-07 Diego Novillo <dnovillo@redhat.com> + + * g++.old-deja/g++.ext/arrnew2.C: Restore XFAIL. It's broken + on mainline too. + +2004-05-06 Richard Henderson <rth@redhat.com> + + * gcc.dg/tree-ssa/20031015-1.c: Rewrite for all targets. Look at + alias dump for two VDEFs. + + * gcc.dg/tree-ssa/20040210-1.c: Tweak scan pattern to look for ifs. + +2004-05-05 Diego Novillo <dnovillo@redhat.com> + + * g++.dg/parse/stack1.C: Remove XFAIL. + * g++.old-deja/g++.bugs/900205_03.C: Likewise. + * g++.old-deja/g++.ext/arrnew2.C: Likewise. + * g++.old-deja/g++.mike/p646.C: Likewise. + * gcc.c-torture/execute/string-opt-19.x: Remove. + +2004-05-05 Andrew Pinski <pinskia@physics.uc.edu> + + PR c/15062 + * gcc.c-torture/compile/pr15062.c: New test. + +2004-05-03 Andrew Pinski <pinskia@physics.uc.edu> + + PR optimization/15245 + * gcc.c-torture/compile/pr15245.c: New test. + +2004-05-03 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20040430-1.c: New test. + +2004-04-26 Bud Davis <bdavis9659@comcast.net> + + PR fortran/14056 + * gfortran.fortran-torture/execute/spec_abs.f90: Add new test. + +2004-04-25 Bud Davis <bdavis9659@comcast.net> + + PR fortran/14942 + * gfortran.fortran-torture/execute/list_read_1.f90: Add new test. + +2004-04-24 Victor Leikehman <lei@il.ibm.com> + + * gfortran.fortran-torture/execute/der_io.f90: New test. + +2004-04-24 Bud Davis <bdavis9659@comcast.net> + + PR fortran/15113 + * gfortran.fortran-torture/execute/a_edit_1.f90: Add new test. + +2004-04-23 Andrew Pinski <pinskia@physics.uc.edu> + + * gcc.c-torture/execute/20040423-1.c: New test. + +2004-04-22 Bud Davis <bdavis9659@comcast.net> + + PR fortran/14906 + * gfortran.fortran-torture/execute/empty_format.f90: Add new test. + +2004-04-21 Ben Elliston <bje@au.ibm.com> + + PR middle-end/14730 + * gcc.c-torture/compile/pr14730.c: New test. + +2004-04-24 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de> + + * execute/intrinsic_count.f90: Fix typo. + * execute/intrinsic_mmloc.f90: Fix typo. + +2004-04-18 Feng Wang <fengwang@nudt.edu.cn> + + PR fortran/14921 + PR fortran/14540 + * gfortran.fortran-torture/execute/math.f90: Add atan2 and clog + simplify test. + +2004-04-15 Andrew Pinski <pinskia@physics.uc.edu> + + * gcc.c-torture/compile/20040415-1.c: New test. + * gcc.c-torture/compile/20040415-2.c: New test. + +2004-04-11 Bud Davis <bdavis9659@comcast.net> + + PR fortran/14904 + * gfortran.fortran-torture/execute/inquire_4.f90: New test. + +2004-04-11 Bud Davis <bdavis9659@comcast.net> + + PR fortran/14901 + * gfortran.fortran-torture/execute/internal_write.f90: New test. + +2004-04-11 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/14872 + * gfortran.fortran-torture/execute/direct_io.f90: Add new test. + +2004-04-11 Feng Wang <fengwang@nudt.edu.cn> + + PR fortran/14377 + * gfortran.fortran-torture/execute/intrinsic_minmax.f90: Add new test. + +2004-04-08 Brian Booth <bbooth@redhat.com> + + * gcc.dg/tree-ssa/20040408-1.c: New test. + +2004-04-08 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20040326-2.c (boz): Add call to abort. + +2004-04-07 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20040326-2.c: Update to test for correct + gimplification of function call expressions. + +2004-04-07 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20040326-2.c: New test. + +2003-04-04 Paul Brook <paul@codesourcery.com> + + PR 13252 + PR 14081 + * gfortran.fortran-torture/execute/strarray_1.f90: New test. + * gfortran.fortran-torture/execute/strarray_2.f90: New test. + * gfortran.fortran-torture/execute/strarray_3.f90: New test. + * gfortran.fortran-torture/execute/strarray_4.f90: New test. + * gfortran.fortran-torture/execute/strcommon_1.f90: New test. + +2004-04-04 Paul Brook <paul@codesourcery.com> + + * lib/fortran-torture.exp (TORTURE_OPTIONS): Remove -fg77-calls. + +2004-04-03 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/14762 + * gfortran.fortran-torture/execute/slash_edit.f90: New test. + +2004-04-03 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/14386 + * gfortran.fortran-torture/execute/inquire_3.f90: New test. + +2004-04-03 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/14837 + * gfortran.fortran-torture/execute/inquire_2.f90: New test. + +2004-04-03 Andrew Pinski <pinskia@physics.uc.edu> + + * lib/gfortran.exp: Sync LD_LIBRARY_PATH part from + lib/g++.exp. + +2004-04-03 Bud Davis <bdavis9659@comcast.net> + + PR 14831 + * gfortran.fortran-torture/execute/inquire_1.f90: New test. + +2004-04-03 Paolo Bonzini <bonzini@gnu.org> + + * gcc.dg/tree-ssa/20040324-1.c: New test. + +2004-04-01 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20040401-1.c: New test. + +2004-04-01 Bud Davis <bdavis9659@comcast.net> + + PR 14746 + * gfortran.fortran-torture/execute/f2_edit_1.f90: New test. + +2004-04-01 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/14565 + * gfortran.fortran-torture/execute/unopened_unit_1.f90: New test. + +2004-03-30 Richard Henderson <rth@redhat.com> + + * gcc.dg/uninit-1.c, gcc.dg/uninit-3.c, gcc.dg/uninit-8.c, + gcc.dg/uninit-9.c: Remove XFAIL. + +2004-03-26 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20040326-1.c: New test. + +2004-03-24 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/csqrt_1.f90: Use f95 style + comments. + +2004-03-24 Bud Davis <bdavis9659@comcast.net> + + PR 14334 + * gfortran.fortran-torture/execute/write_logical_1.f90: New test. + +2004-03-24 Bud Davis <bdavis9659@comcast.net> + + PR 13919 + * gfortran.fortran-torture/execute/read_eof.f90: New test. + +2004-03-24 Bud Davis <bdavis9659@comcast.net> + + PR 14396 + * gfortran.fortran-torture/execute/csqrt_1.f90: New test. + +2004-02-24 Paul Brook <paul@codesourcery.com> + + PR 14055 + * gfortran.fortran-torture/execute/plusconst_1.f90: New test. + +2004-03-23 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/20040420-1.c: Move and rename ... + * gcc.c-torture/compile/20040220-1.c ... here. + +2004-03-23 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/20040211-1.c: Update outcome. + * gcc.dg/tree-ssa/ssa-dce-3.c: New test. + +2004-03-19 Diego Novillo <dnovillo@redhat.com> + + PR optimization/14643 + * gcc.dg/tree-ssa/20040319-1.c: New test. + +2004-03-19 Jeff Law <law@redhat.com> + + * gcc.c-torture/execute/20040319-1.c: New test. + +2004-03-17 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20040317-1.c: New test. + * gcc.c-torture/compile/20040317-2.c: New test. + * gcc.c-torture/compile/20040317-3.c: New test. + +2004-03-17 Diego Novillo <dnovillo@redhat.com> + + PR optimization/14511 + * g++.dg/tree-ssa/20040317-1.C: New test. + +2004-03-13 Diego Novillo <dnovillo@redhat.com> + + PR optimization/14553 + * gcc.dg/tree-ssa/20040313-1.c: New test. + +2004-03-11 Kazu Hirata <kazu@cs.umass.edu> + + * gcc.dg/tree-ssa/20040305-1.c: Change a constant to fit in a + 16-bit int. + +2004-03-10 Andrew Pinski <apinski@apple.com> + + PR c/14475 + * gcc.dg/pr14475.c: New test. + +2004-03-09 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20040309-1.c: New test. + +2004-03-05 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20040305-1.c: New test. + +2004-03-04 Jeff Law <law@redhat.com> + + * gcc.c-torture/20040304-1.c: New test. + +2004-03-03 Jeff Law <law@redhat.com> + + * gcc.c-torture/20040303-1.c: New test. + * gcc.c-torture/20040303-2.c: New test. + +2004-03-02 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/tailrecursion-5.c: New test. + +2004-03-02 Diego Novillo <dnovillo@redhat.com> + + * testsuite/gcc.dg/tree-ssa/20030815-1.c: Expect 1 type cast. + * testsuite/gcc.dg/tree-ssa/ssa-dce-1.c: Check after aliasing. + * testsuite/gcc.dg/tree-ssa/ssa-dce-2.c: Likewise. + * testsuite/gcc.dg/tree-ssa/ssa-dom-cse-1.c: Likewise. + +2004-03-02 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20040302-1.c: New test. + +2004-02-10 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20040211-1.c: Update slightly. + +2004-02-27 Richard Henderson <rth@redhat.com> + + * gcc.dg/warn-1.c: Update warning line. + * gcc.dg/tree-ssa/20030730-1.c: Declare ggc_alloc. + * gcc.dg/tree-ssa/20030730-2.c: Likewise. + * gcc.dg/tree-ssa/20030917-2.c: Fix int->pointer cast. + * gcc.dg/tree-ssa/20030922-2.c: XFAIL. + +2004-02-27 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/tailcall-2.c: New test. + +2004-02-20 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/copy-headers.c: New test. + * gcc.dg/tree-ssa/20030711-1.c: Update outcome. + * gcc.dg/tree-ssa/20030714-2.c: Ditto. + * gcc.dg/tree-ssa/20030807-3.c: Ditto. + +2004-02-10 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20040219-1.c: New test. + +2004-02-16 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030807-4.c: Remove bogus test. + + * gcc.dg/tree-ssa/20040216-1.c: New test. + * gcc.dg/tree-ssa/20040211-1.c: New test. + +2004-02-15 Paul Brook <paul@codesourcery.com> + + PR fortran/13433 + * gfortran.fortran-torture/execute/straret.f90: New test. + +2004-02-14 Richard Henderson <rth@redhat.com> + + * gcc.c-torture/execute/20030120-3.c: Remove duplicate of 920415-1.c. + +2004-02-11 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20040210-1.c: New test. + +2004-02-10 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20000603-1.c: Resolve alias ambiguity and + point to DR#236. + +2004-02-09 Richard Henderson <rth@redhat.com> + + * gcc.dg/noreturn-1.c: Adjust line numbers on warnings. + * gcc.dg/noreturn-4.c: Likewise. + * gcc.dg/noreturn-7.c: Likewise. Adjust warnings for + changes to tail-call optimizations. + * gcc.dg/return-type-3.c: Turn on optimization. + * gcc.dg/uninit-6.c: Adjust line numbers on warnings. + * gcc.dg/uninit-8.c: XFAIL. + +2004-02-09 Feng Wang <fengwang@nudt.edu.cn> + + * gfortran.fortran-torture/execute/specifics.f90: Fix mod type. + +2004-02-09 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20040209-2.c: New test. + +2004-02-06 Feng Wang <fengwang@nudt.edu.cn> + + * gfortran.fortran-torture/execute/intrinsic_dotprod.f90: Add complex + test. + +2004-02-07 Bud Davis <bdavis9659@comcast.net> + + PR libfortran/14038 + * gfortran.fortran-torture/execute/holletith.f90: New test. + +2004-02-06 Andrew Pinski <pinskia@physics.uc.edu> + + PR middle-end/13127 + * gcc.dg/20040206-1.c: New test. + +2004-02-04 Richard Henderson <rth@redhat.com> + + * g++.dg/opt/bool1.C: Declare abort. + +2004-02-04 Richard Henderson <rth@redhat.com> + + * gcc.dg/tree-ssa/ssa-ccp-10.c: Look at fab dump. + +2004-02-03 Richard Henderson <rth@redhat.com> + + * gcc.dg/tree-ssa/20040204-1.c: Rename from ssa-ccp-5.c. + Look at .optimized output. XFAIL. + * gcc.dg/tree-ssa/ssa-ccp-11.c: XFAIL. + * gcc.dg/tree-ssa/ssa-ccp-3.c: XFAIL. + * gcc.dg/tree-ssa/ssa-ccp-4.c: Remove. + * gcc.dg/tree-ssa/ssa-ccp-6.c: Remove. + * gcc.dg/tree-ssa/ssa-ccp-8.c: Remove. + + * gcc.dg/tree-ssa/20030731-1.c: XFAIL. + * gcc.dg/tree-ssa/20030814-6.c: XFAIL. + * gcc.dg/tree-ssa/20031106-1.c: XFAIL. + * gcc.dg/tree-ssa/20031106-2.c: XFAIL. + * gcc.dg/tree-ssa/20031106-3.c: XFAIL. + * gcc.dg/tree-ssa/20031106-4.c: XFAIL. + * gcc.dg/tree-ssa/20031106-5.c: XFAIL. + * gcc.dg/tree-ssa/20031106-6.c: XFAIL. + * gcc.dg/tree-ssa/sra-2.c: XFAIL. + * gcc.dg/tree-ssa/sra-3.c: XFAIL. + + * gcc.dg/i386-ssetype-1.c: XFAIL. + * gcc.dg/i386-ssetype-3.c: XFAIL. + +2004-02-03 Steven Bosscher <stevenb@suse.de> + + * gcc.dg/tree-ssa/20030709-2.c: Replace `dce4' with `cddce' for + tree dump scans. + * gcc.dg/tree-ssa/20030808-1.c: Likewise. + +2004-01-31 Canqun Yang <canqun@nudt.edu.cn> + + * gfortran.fortran-torture/execute/intrinsic_mmloc_4.f90: + Delete print statements. + +2004-01-25 Richard Henderson <rth@redhat.com> + + * gcc.c-torture/execute/930529-1.x: Disable, update commentary. + +2004-01-21 Richard Henderson <rth@redhat.com> + + * gcc.dg/tree-ssa/asm-1.c: Fix memory constaint. + +2004-01-21 Dale Johannesen <dalej@apple.com> + + * gcc.dg/tree-ssa/20040121-1.c: New test. + +2004-01-17 Richard Henderson <rth@redhat.com> + + * gcc.c-torture/execute/string-opt-18.x: Remove. + * gcc.dg/uninit-2.c, gcc.dg/uninit-4.c: Don't XFAIL. + * gcc.dg/uninit-5.c, gcc.dg/uninit-8.c: Likewise. + +2004-01-16 Steven Bosscher <stevenb@suse.de> + + * gcc.dg/tree-ssa/20030709-2.c, gcc.dg/tree-ssa/20030808-1.c: + Update for extra DCE pass. + +2004-01-15 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030807-1.c: Update due to improvements in + jump threading. + +2004-01-12 Richard Henderson <rth@redhat.com> + + * gcc.dg/tree-ssa/20030808-1.c: Fix dump option. + * gcc.dg/tree-ssa/20031015-1.c: Update dump name. + * gcc.dg/tree-ssa/tailcall-1.c, gcc.dg/tree-ssa/tailrecursion-1.c, + gcc.dg/tree-ssa/tailrecursion-2.c, gcc.dg/tree-ssa/tailrecursion-3.c, + gcc.dg/tree-ssa/tailrecursion-4.c: Likewise. + +2004-01-11 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/emptyif.f90: New test. + +2004-01-11 Feng Wang <fengwang@nudt.edu.cn> + + * gfortran.fortran-torture/execute/cmplx.f90: Add dcmplx test. + +2004-01-10 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/mystery_proc.f90: New test. + * gfortran.fortran-torture/compile/mystery_proc.f90: Remove. + +2004-01-10 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/intrinsic_minmax.f90: Test + specific names. + +2004-01-10 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/intrinsic_transpose.f90: Test + complex variables. + +2004-01-09 Steven Bosscher <stevenb@suse.de> + + * gcc.dg/tree-ssa/useless-1.c: New test. + +2004-01-07 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030530-2.c: Adjust dump file patterns. + * gcc.dg/tree-ssa/20030611-1.c: Likewise. + * gcc.dg/tree-ssa/20030703-1.c: Likewise. + * gcc.dg/tree-ssa/20030703-2.c: Likewise. + * gcc.dg/tree-ssa/20030708-1.c: Likewise. + * gcc.dg/tree-ssa/20030709-2.c: Likewise. + * gcc.dg/tree-ssa/20030709-3.c: Likewise. + * gcc.dg/tree-ssa/20030710-1.c: Likewise. + * gcc.dg/tree-ssa/20030711-1.c: Likewise. + * gcc.dg/tree-ssa/20030711-2.c: Likewise. + * gcc.dg/tree-ssa/20030711-3.c: Likewise. + * gcc.dg/tree-ssa/20030714-1.c: Likewise. + * gcc.dg/tree-ssa/20030714-2.c: Likewise. + * gcc.dg/tree-ssa/20030729-1.c: Likewise. + * gcc.dg/tree-ssa/20030730-1.c: Likewise. + * gcc.dg/tree-ssa/20030730-2.c: Likewise. + * gcc.dg/tree-ssa/20030731-1.c: Likewise. + * gcc.dg/tree-ssa/20030807-10.c: Likewise. + * gcc.dg/tree-ssa/20030807-11.c: Likewise. + * gcc.dg/tree-ssa/20030807-2.c: Likewise. + * gcc.dg/tree-ssa/20030807-3.c: Likewise. + * gcc.dg/tree-ssa/20030807-4.c: Likewise. + * gcc.dg/tree-ssa/20030807-5.c: Likewise. + * gcc.dg/tree-ssa/20030807-6.c: Likewise. + * gcc.dg/tree-ssa/20030807-7.c: Likewise. + * gcc.dg/tree-ssa/20030807-8.c: Likewise. + * gcc.dg/tree-ssa/20030807-9.c: Likewise. + * gcc.dg/tree-ssa/20030808-1.c: Likewise. + * gcc.dg/tree-ssa/20030814-1.c: Likewise. + * gcc.dg/tree-ssa/20030814-2.c: Likewise. + * gcc.dg/tree-ssa/20030814-3.c: Likewise. + * gcc.dg/tree-ssa/20030814-4.c: Likewise. + * gcc.dg/tree-ssa/20030814-5.c: Likewise. + * gcc.dg/tree-ssa/20030814-6.c: Likewise. + * gcc.dg/tree-ssa/20030814-7.c: Likewise. + * gcc.dg/tree-ssa/20030815-1.c: Likewise. + * gcc.dg/tree-ssa/20030922-1.c: Likewise. + * gcc.dg/tree-ssa/20030807-1.c: Likewise. + Fix test to avoid dereferencing a NULL pointer. + +2004-01-07 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030709-2.c: Update test and expected + output to accomodate improvements in the optimizers. + +2004-01-02 Dan Nicolaescu <dann@ics.uci.edu> + + * gcc.dg/tree-ssa/sra-3.c: Replace test, old version was a + copy of sra-2.c + +2004-01-01 Paul Brook <paul@codesourcery.com> + + * gfortran.fortran-torture/execute/data_2.f90: New test. + +2003-12-16 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20031216-2.c: Remove duplicate test. + * gcc.dg/tree-ssa/20030807-7.c: Use -O2 to enable strict + aliasing. + (simplify_condition): Remove static declarator. + +2003-12-16 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20031216-2.c: New test. + +2003-12-16 Dan Nicolaescu <dann@ics.uci.edu> + + * gcc.dg/tree-ssa/sra-1.c: New test. + * gcc.dg/tree-ssa/sra-2.c: New test. + * gcc.dg/tree-ssa/sra-3.c: New test. + * gcc.dg/tree-ssa/20031216-1.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-11.c: New test. + +2003-12-12 Jeff Law <law@redhat.com> + + * ssa-dom-thread-1.c: Update now that jump threading pass is + no longer separate from the dominator optimizer. + +2003-12-12 Huang Chun <chunhuang73@hotmail.com> + + * gfortran.fortran-torture/execute/intrinsic_len.f90: Fix. + * gfortran.fortran-torture/execute/intrinsic_index.f90: New test. + +2003-12-11 Jeff Law <law@redhat.com> + + * gcc.c-torture/execute/20031211-1.c: New test. + * gcc.c-torture/execute/20031211-2.c: New test. + +2003-12-05 Canqun Yang <canqun@nudt.edu.cn> + + * gfortran.fortran-torture/execute/common.f90: New test for + COMMON and EQUIVALENCE. + +2003-12-01 Feng Wang <fengwang@nudt.edu.cn> + + * gfortran.fortran-torture/excute/intrinsic_fraction_exponent.f90: + Use correct types. Handle negative exponents. + * gfortran.fortran-torture/excute/intrinsic_scale.f90: Remove + incorrect conditions. + +2003-12-01 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tls/asm-1.c: Update expected error message. + +2003-11-30 Andrew Pinski <pinskia@physics.uc.edu> + + PR optimization/13067 + * g++.dg/opt/cfg4.C: New test. + +2003-11-30 Paul Brook <paul@nowt.org> + + PR fortran/13155 + * gfortran.fortran-torture/execute/module_interface_2.f90: New test. + +2003-11-29 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/allocate.f90: New test. + +2003-11-27 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/ssa-ccp-10.c: New test. + +2003-11-26 Richard Henderson <rth@redhat.com> + + * gfortran.fortran-torture/execute/intrinsic_nearest.f90: Correctly + test behaviour at infinity. + +2003-11-25 Canqun Yang <canqun@nudt.edu.cn> + + * gfortran.fortran-torture/execute/common_size.f90: New test for + size of COMMON block containing EQUIVALENCE objects. + +2003-11-24 Richard Henderson <rth@redhat.com> + + * gcc.c-torture/compile/20031124-1.c: New. + +2003-11-24 Paul Brook <paul@nowt.org> + + PR fortran/13154 + * gfortran.fortran-torture/compile/module_common.f90: New test. + +2003-11-18 Jan Hubicka <jh@suse.cz> + + * gcc.dg/tree-ssa/tailcall-1.c: New. + * gcc.dg/tree-ssa/tailrecursion-?.c: Rename dump + +2003-11-18 Jan Hubicka <jh@suse.cz> + + * gcc.dg/tree-ssa/tailrecursion-1.c: New test. + * gcc.dg/tree-ssa/tailrecursion-2.c: New test. + * gcc.dg/tree-ssa/tailrecursion-3.c: New test. + * gcc.dg/tree-ssa/tailrecursion-4.c: New test. + +2003-11-13 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/module_interface.f90: New test. + +2003-11-13 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030808-1.c:Scan dce2 output rather than dom2 + output. + + * gcc.dg/tree-ssa/20030728-1.c: Update for jump threading changes. + + * gcc.dg/tree-ssa/20030730-1.c: No longer expect abort declaration + to be present. + + * gcc.dg/tree-ssa/20030730-1.c: Make "foo" have external linkage. + * gcc.dg/tree-ssa/20030730-2.c: Similarly. + +2003-11-13 Jan Hubicka <jh@suse.cz> + + * gcc.dg/tree-ssa/ssa-dce-1.c: New test. + * gcc.dg/tree-ssa/ssa-dce-2.c: New test. + * gcc.dg/tree-ssa/ssa-dom-ccp-1.c: New test. + * gcc.dg/tree-ssa/ssa-dom-cse-1.c: New test. + * gcc.dg/tree-ssa/ssa-dom-thread-1.c: New test. + * gcc.dg/tree-ssa/cfgcleanup-1.c: New test. + +2003-11-13 Steven Bosscher <stevenb@suse.de> + + * gcc.dg/tree-ssa/20031113-1.c: New test. + +2003-11-12 Jan Hubicka <jh@suse.cz> + + * g++.dg/tree-ssa: New file. + * g++.dg/tree-ssa/tree-ssa.exp: New file based on + gcc.dg/tree-ssa/tree-ssa.exp. + * g++.dg/tree-ssa/nothrow-1.C: New test. + +2003-11-11 Canqun Yang <canqun@nudt.edu.cn> + + * gfortran.fortran-torture/execute/stack_varsize.f90: New test. + +2003-11-08 Paul Brook <paul@nowt.org> + + * gfortran.fortran-toriture/execute/intrinsic_mmloc_3.f90: Extra test. + * gfortran.fortran-toriture/execute/intrinsic_mmloc_4.f90: New test. + +2003-11-06 Paul Brook <paul@nowt.org> + + * gfortran.fortran-toriture/execute/intrinsic_mmloc_3.f90: New test. + +2003-11-06 Dan Nicolaescu <dann@ics.uci.edu> + + * gcc.dg/tree-ssa/20031106-1.c: New test. + * gcc.dg/tree-ssa/20031106-2.c: New test. + * gcc.dg/tree-ssa/20031106-3.c: New test. + * gcc.dg/tree-ssa/20031106-4.c: New test. + * gcc.dg/tree-ssa/20031106-5.c: New test. + * gcc.dg/tree-ssa/20031106-6.c: New test. + +2003-11-06 Steven Bosscher <stevenb@suse.de> + + * gcc.dg/tree-ssa/ssa-ccp-2.c: Fix overoptimistic expectations + of our optimizers. + +2003-10-31 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20031031-1.c: New test. + +2003-10-30 Richard Henderson <rth@redhat.com> + + * g++.dg/warn/Wswitch-1.C: Move "case value not in enumerated type" + warning to the proper line. + * gcc.dg/Wswitch-enum.c: Likewise. + * gcc.dg/Wswitch.c: Likewise. + +2003-10-22 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20031022-1.c: New test. + +2003-10-17 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/intrinsic_size.f90: Add + additional case. + +2003-10-17 Feng Wang <wf_cs@yahoo.com> + + * gfortran.fortran-torture/execute/intrinsic_mmloc_2.f90: New test. + +2003-10-16 Richard Henderson <rth@redhat.com> + + * g++.dg/ext/asm3.C: Update expected error text. + +2003-10-16 Steven Bosscher <steven@gcc.gnu.org> + + * gcc.dg/noreturn-1.c: Adjust expected error lines. + * gcc.dg/return-type-1.c: Likewise. + +2003-10-15 Steven Bosscher <steven@gcc.gnu.org> + + * gcc.dg/tree-ssa/20031015-1.c: New test. + +2003-10-14 Richard Henderson <rth@redhat.com> + + * gcc.dg/asm-7.c: Update expected error text. + +2003-10-14 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030918-1.c: New test. + +2003-10-13 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/retarray_2.f90: New test. + * gfortran.fortran-torture/compile/named_args.f90: New test. + +2003-10-12 Feng Wang <wf_cs@yahoo.com> + + * gfortran.fortran-torture/execute/intrinsic_cshift.f90: New test. + +2003-10-11 Huang Chun <jiwang@mail.edu.cn> + + * gfortran.fortran-torture/execute/intrinsic_len.f90: New test. + * gfortran.fortran-torture/execute/intrinsic_trim.f90: New test. + +2003-10-11 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/specifics.f90: New test. + * gfortran.fortran-torture/execute/intrinsic_achar.f90: New test. + * gfortran.fortran-torture/execute/strret.f90: Also test result vars. + +2003-10-01 Richard Henderson <rth@redhat.com> + + * g++.dg/parse/crash10.C: Adjust expected error lines. + * g++.old-deja/g++.other/crash31.C: Likewise. + +2003-09-29 Richard Henderson <rth@redhat.com> + + * g++.dg/ext/stmtexpr1.C, g++.dg/parse/stack1.C: XFAIL. + +2003-09-29 Richard Henderson <rth@redhat.com> + + * g++.dg/opt/nothrow1.C: Use locally declared function rather + than printf. + + * g++.dg/ext/label3.C: Add dg-options. + +2003-09-25 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030922-2.c: New test. + +2003-09-24 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030708-1.c: Expect all IF conditions to be + removed. + * gcc.dg/tree-ssa/20030808-1.c: Similarly. + + * gcc.dg/tree-ssa/20030807-9.c: Add additional test. + +2003-09-22 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030922-1.c: New test. + + * gcc.dg/tree-ssa/20030807-2.c: Add additional cases to this test. + +2003-09-21 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030920-1.c: New test. + +2003-09-21 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030703-2.c: Expect one if() conditional after + the second dominator pass. + * gcc.dg/tree-ssa/20030807-1.c: Likewise. + * gcc.dg/tree-ssa/20030807-1.c: Add return statement to avoid DCE + removing the whole body. + Expect two if() statements after the second dominator pass. + * gcc.dg/tree-ssa/20030807-7.c: Explain why we fail to optimize. + +2003-09-21 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030530-2.c: Adjust to use -fdump-tree-dom2. + * gcc.dg/tree-ssa/20030611-1.c: Likewise. + * gcc.dg/tree-ssa/20030703-1.c: Likewise + * gcc.dg/tree-ssa/20030703-2.c: Likewise. + * gcc.dg/tree-ssa/20030708-1.c: Likewise. + * gcc.dg/tree-ssa/20030709-2.c: Likewise. + * gcc.dg/tree-ssa/20030709-3.c: Likewise. + * gcc.dg/tree-ssa/20030710-1.c: Likewise. + * gcc.dg/tree-ssa/20030711-1.c: Likewise. + * gcc.dg/tree-ssa/20030711-2.c: Likewise. + * gcc.dg/tree-ssa/20030711-3.c: Likewise. + * gcc.dg/tree-ssa/20030714-1.c: Likewise. + * gcc.dg/tree-ssa/20030714-2.c: Likewise. + * gcc.dg/tree-ssa/20030729-1.c: Likewise. + * gcc.dg/tree-ssa/20030730-1.c: Likewise. + * gcc.dg/tree-ssa/20030730-2.c: Likewise. + * gcc.dg/tree-ssa/20030731-1.c: Likewise. + * gcc.dg/tree-ssa/20030807-1.c: Likewise. + * gcc.dg/tree-ssa/20030807-10.c: Likewise. + * gcc.dg/tree-ssa/20030807-11.c: Likewise. + * gcc.dg/tree-ssa/20030807-2.c: Likewise. + * gcc.dg/tree-ssa/20030807-3.c: Likewise. + * gcc.dg/tree-ssa/20030807-4.c: Likewise. + * gcc.dg/tree-ssa/20030807-5.c: Likewise. + * gcc.dg/tree-ssa/20030807-6.c: Likewise. + * gcc.dg/tree-ssa/20030807-7.c: Likewise. + * gcc.dg/tree-ssa/20030807-8.c: Likewise. + * gcc.dg/tree-ssa/20030807-9.c: Likewise. + * gcc.dg/tree-ssa/20030808-1.c: Likewise. + * gcc.dg/tree-ssa/20030814-1.c: Likewise. + * gcc.dg/tree-ssa/20030814-2.c: Likewise. + * gcc.dg/tree-ssa/20030814-3.c: Likewise. + * gcc.dg/tree-ssa/20030814-4.c: Likewise. + * gcc.dg/tree-ssa/20030814-5.c: Likewise. + * gcc.dg/tree-ssa/20030814-6.c: Likewise. + * gcc.dg/tree-ssa/20030814-7.c: Likewise. + * gcc.dg/tree-ssa/20030815-1.c: Likewise. + * gcc.dg/tree-ssa/20030824-2.c: Likewise. + * gcc.dg/tree-ssa/20030907-1.c: Likewise. + +2003-09-21 Lifang Zeng <zlf605@hotmail.com> + + * gfortran.fortran-torture/execute/data.f90: New test. + +2003-09-20 Kejia Zhao <kejia_zh@yahoo.com.cn> + + * gfortran.fortran-torture/execute/intrisic_si_kind.f90: New test. + * gfortran.fortran-torture/execute/intrisic_sr_kind.f90: New test. + +2003-09-17 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030917-2.c: New test. + +2003-09-17 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20030917-1.c: New test. + + * gcc.dg/tree-ssa/20030917-1.c: New test. + * gcc.dg/tree-ssa/20030917-3.c: New test. + + * gcc.dg/tree-ssa/20030807-8.c: Update. + +2003-09-14 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/der_init.f90: Also test arrays. + +2003-09-13 Paul Brook <paul@nowt.org> + + * gcc.c-torture/execute/20030913-1.c: New test. + +2003-09-10 Kejia Zhao <kejia_zh@yahoo.com.cn> + + * gfortran.fortran-torture/intrinsic_fraction_exponent.f90: New test. + * gfortran.fortran-torture/intrinsic_nearest.f90: New test. + * gfortran.fortran-torture/intrinsic_rrspacing.f90: New test. + * gfortran.fortran-torture/intrinsic_scale.f90: New test. + * gfortran.fortran-torture/intrinsic_set_exponent.f90: New test + * gfortran.fortran-torture/intrinsic_spacing.f90: New test. + +2003-09-10 Paul Brook <paul@nowt.org> + + * gcc.c-torture/execute/20030910-1.c: New test. + * gcc.g-torture/compile/20030910-1.c: New test. + +2003-09-09 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.c-torture/execute/20030909-1.c: New test. + +2003-09-07 Steven Bosscher <steven@gcc.gnu.org> + + PR optimization/12198 + * gcc.dg/tree-ssa/20030907-1.c: New test. + + PR optimization/12109 + * gcc.dg/tree-ssa/20030907-2.c: New test. + +2003-09-04 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20030828-1.c: New test. + * gcc.c-torture/execute/20030828-2.c: New test. + +2003-09-02 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20030902-1.c: New test. + +2003-08-27 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030821-1.c: Don't get confused by declaration + of dont_remove. + +2003-08-25 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030815-1.c: New test. + * gcc.dg/tree-ssa/20030821-1.c: New test. + + +2003-08-25 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/20030825-1.c: New test. + +2003-08-24 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030824-1.c: New test. + * gcc.dg/tree-ssa/20030824-2.c: New test. + +2003-08-23 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/compile/20030823-1.c: New test. + +2003-08-20 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/tree-ssa/20030807-3.c: Adjust expected number of + conditionals. + * gcc.dg/tree-ssa/20030807-4.c: Likewise. + +2003-08-20 Zdenek Dvorak <rakdver@atrey.karlin.mff.cuni.cz> + + * gcc.dg/tree-ssa/20030820-1.c: New test. + * gcc.dg/tree-ssa/20030820-2.c: New test. + +2003-08-15 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030814-6.c: New test. + * gcc.dg/tree-ssa/20030814-7.c: New test. + + * gcc.dg/tree-ssa/20030814-4.c: Test optimized output to verify + useless statement created by out-of-ssa pass is removed. + * gcc.dg/tree-ssa/20030814-5.c: Similarly. + +2003-08-14 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/compile/allocate.f90: Also test scalars. + +2003-08-14 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030814-1.c: New test. + * gcc.dg/tree-ssa/20030814-2.c: New test. + * gcc.dg/tree-ssa/20030814-3.c: New test. + * gcc.dg/tree-ssa/20030814-4.c: New test. + * gcc.dg/tree-ssa/20030814-5.c: New test. + + * gcc.dg/tree-ssa/20030708-1.c: There should only be one conditional. + * gcc.dg/tree-ssa/20030714-2.c: New test. + * gcc.dg/tree-ssa/20030731-1.c: New test. + + * gcc.dg/tree-ssa/20030711-2.c: Update slightly to avoid + dereferences of constant addresses. + + * gcc.dg/tree-ssa/20030729-1.c: Remove incorrect test for + IF statement removal. + + * gcc.dg/tree-ssa/20030808-1.c: New test. + +2003-08-12 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030807-8.c: New test. + +2003-08-12 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/builtins/string-4.x: Remove. + +2003-08-12 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/execute/forall_4.f90: Fix illegal code. + +2003-08-12 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/*.c: Add missing close braces to various tests. + + * gcc.dg/tree-ssa/20030807-6.c: New test. + * gcc.dg/tree-ssa/20030807-7.c: New test. + * gcc.dg/tree-ssa/20030807-9.c: New test. + * gcc.dg/tree-ssa/20030807-11.c: New test. + +2003-08-11 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030807-1.c: New test. + * gcc.dg/tree-ssa/20030807-2.c: New test. + * gcc.dg/tree-ssa/20030807-3.c: New test. + * gcc.dg/tree-ssa/20030807-4.c: New test. + * gcc.dg/tree-ssa/20030807-5.c: New test. + * gcc.dg/tree-ssa/20030807-10.c: New test. + +2003-08-10 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture/compile/allocate.f90: Also test memebers of + derived types. + +2003-08-05 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030731-2.c: New test. + * gcc.c-torture/execute/builtins/string-5.x: Kill. + +2003-07-30 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030730-1.c: New test. + * gcc.dg/tree-ssa/20030730-2.c: New test. + * gcc.dg/tree-ssa/20030729-1.c: Fix comment typo. + +2003-07-29 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030729-1.c: New test. + + * gcc.dg/tree-ssa/20030709-1.c: Look at the .optimized output. + + * gcc.dg/tree-ssa/20030711-2.c: There should only be one load + of rtmem after rewriting into SSA form. + +2003-07-28 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030728-1.c: New test. + +2003-07-26 Paul Brook <paul@nowt.org> + + * gfortran.fortran-torture: New testsuite. + * lib/fortran-torture.exp: New file. + * lib/gfortran.exp: New file. + +2003-07-16 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030709-2.c: Also test that we eliminate + the redundant load of ->fld[1].rtmem. + + * gcc.c-torture/compile/20030716-1.c: New test. + +2003-07-16 Dan Nicolaescu <dann@ics.uci.edu> + + * gcc.dg/tree-ssa/ssa-ccp-1.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-2.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-3.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-4.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-5.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-6.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-7.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-8.c: New test. + * gcc.dg/tree-ssa/ssa-ccp-9.c: New test. + +2003-07-10 Jeff Law <law@redhat.com> + + * gcc.dg/tree-ssa/20030703-1.c: New test. + * gcc.dg/tree-ssa/20030703-2.c: New test. + * gcc.dg/tree-ssa/20030708-1.c: New test. + * gcc.dg/tree-ssa/20030709-1.c: New test. + * gcc.dg/tree-ssa/20030709-2.c: New test. + * gcc.dg/tree-ssa/20030709-3.c: New test. + * gcc.dg/tree-ssa/20030710-1.c: New test. + * gcc.dg/tree-ssa/20030711-1.c: New test. + * gcc.dg/tree-ssa/20030711-2.c: New test. + * gcc.dg/tree-ssa/20030711-3.c: New test. + * gcc.dg/tree-ssa/20030714-1.c: New test. + +2003-07-10 Jeff Law <law@redhat.com> + + * lib/scantree.exp: Always glob the output file. +: +2003-06-27 Diego Novillo <dnovillo@redhat.com> + + * gcc.dg/20030612-1.c: New test. + +2003-06-25 Jeff Law <law@redhat.com> + + * gcc.dg/noncompile/920507-1.c: Return a value so that the + variable "a" is always used. + +2003-06-11 Jeff Law <law@redhat.com> + + * gcc.c-torture/gcc.dg/tree-ssa/20030611-1.c: New test. + + * gcc.c-torture/compile/20030530-2.c: Move to... + * gcc.c-torture/gcc.dg/tree-ssa/20030530-2.c: Here. Use dg + and scan-tree-output framework. Verify that redundant expressions + are removed. + * gcc.c-torture/gcc.dg/tree-ssa/tree-ssa.exp: New driver. + * lib/gcc.dg.exp: Load scantree.exp. + * lib/scantree.exp: New library of routines to scan tree dumps. + +2003-06-03 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/builtins/string-4.x: Expect + execution failures. + * gcc.c-torture/execute/builtins/string-5.x: Likewise. + +2003-05-30 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20030530-1.c: New test. + * gcc.c-torture/compile/20030530-2.c: New test. + * gcc.c-torture/compile/20030530-3.c: New test. + +2003-05-12 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/string-opt-19.x: Expect execution + failures. + +2003-05-06 Jeff Law <law@redhat.com> + + * gcc.c-torture/execute/string-opt-18.x: Expect execution + failures. + +2003-05-01 Jeff Law <law@redhat.com> + + * gcc.c-torture/execute/20030501-1.c: New test for tree-ssa bug. + +2003-04-16 Jeff Law <law@redhat.com> + + * gcc.c-torture/compile/20030416-1.c: New test from Diego. + + * gcc.c-torture/execute/20030120-3.c: Updates suggested by Kaveh. + +2003-04-05 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/compile/20030405-1.[cx]: New test. + +2003-04-05 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20030404-1.c: New test. + +2003-04-03 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20030403-1.c: New test. + +2003-03-10 Steven Bosscher <s.bosscher@student.tudelft.nl> + + * gcc.c-torture/compile/20030310-1.c: New test. + +2003-02-12 Jeff Law <law@redhat.com> + + * gcc.c-torture/execute/20030120-3.c: New test. + +2003-02-08 Diego Novillo <dnovillo@redhat.com> + + * lib/c-torture.exp: Remove -ftree-dce from compiler flags. + +2003-02-06 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/compile/20001226-1.c: Remove deliberate syntax + error. + +2003-02-02 Diego Novillo <dnovillo@redhat.com> + + * lib/c-torture.exp (TORTURE_OPTIONS): Add -ftree-dce. + +2003-01-28 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/builtin-constant.x: Remove. + +2003-01-05 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/compile/20001226-1.c: Add clarifying + remarks about why we introduced a deliberate syntax + error. + +2002-11-24 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/compile/20001226-1.c: Introduce a + deliberate syntax error. + +2002-11-13 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20021113-1.c: New test. + +2002-08-19 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20020819-1.c: New test. + +2002-08-21 Diego Novillo <dnovillo@redhat.com> + + * gcc.c-torture/execute/20020819-1.c: Add exit(0). diff --git a/gcc/testsuite/g++.dg/README b/gcc/testsuite/g++.dg/README index 4e2e4ce9bbc..14b736e7a73 100644 --- a/gcc/testsuite/g++.dg/README +++ b/gcc/testsuite/g++.dg/README @@ -22,6 +22,7 @@ rtti Tests for run-time type identification (typeid, dynamic_cast, etc.) template Tests for templates. tc1 Tests for Technical Corrigendum 1 conformance. tls Tests for support of thread-local data. +tree-ssa Tests for Tree SSA optimizations. warn Tests for compiler warnings. other Tests that don't fit into one of the other categories. diff --git a/gcc/testsuite/g++.dg/eh/goto1.C b/gcc/testsuite/g++.dg/eh/goto1.C new file mode 100644 index 00000000000..f3e3e4216fb --- /dev/null +++ b/gcc/testsuite/g++.dg/eh/goto1.C @@ -0,0 +1,34 @@ +extern "C" void abort (); + +static int count; + +struct S { + S() { ++count; } + ~S() { --count; } +}; + +int foo(int p) +{ + S s1; + { + S s2; + if (p) + goto L; + else + return 1; + } + foo (p); + L: + return 0; +} + +int main() +{ + foo(0); + if (count != 0) + abort (); + foo(1); + if (count != 0) + abort (); + return 0; +} diff --git a/gcc/testsuite/g++.dg/ext/asm3.C b/gcc/testsuite/g++.dg/ext/asm3.C index 699ab4c8252..5eff16ffe7c 100644 --- a/gcc/testsuite/g++.dg/ext/asm3.C +++ b/gcc/testsuite/g++.dg/ext/asm3.C @@ -8,6 +8,6 @@ int two(int in) { register int out; - __asm__ ("" : "r" (out) : "r" (in)); // { dg-error "output operand" "" } + __asm__ ("" : "r" (out) : "r" (in)); // { dg-error "" "" } return out; } diff --git a/gcc/testsuite/g++.dg/ext/label3.C b/gcc/testsuite/g++.dg/ext/label3.C new file mode 100644 index 00000000000..604bfdc12c3 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/label3.C @@ -0,0 +1,39 @@ +// Bug: we were removing the p = q assignment in dce, and then reinserting +// it *after* the try/catch in out-of-ssa. Oops. + +// testcase reduced from libjava/interpret.cc. + +// { dg-do run } +// { dg-options "-O2" } + +extern "C" int printf (const char *, ...); + +bool b; + +int main() +{ + __label__ one, two, done; + void *labs[] = { &&one, &&two, &&done }; + const void **q = (const void **)labs; + const void **p = q; + + try + { + one: + printf ("one!\n"); + if (b) + throw 42; + goto **p++; + + two: + printf ("two!\n"); + goto **p++; + + done: + printf ("done!\n"); + } + catch (int) + { + printf ("caught!\n"); + } +} diff --git a/gcc/testsuite/g++.dg/init/pmf1.C b/gcc/testsuite/g++.dg/init/pmf1.C new file mode 100644 index 00000000000..93c67bdd706 --- /dev/null +++ b/gcc/testsuite/g++.dg/init/pmf1.C @@ -0,0 +1,17 @@ +// PR c++/14089 +// { dg-do compile } +// +// C++ front end generated assignment between types that were not +// compatible in any sense visible to the optimizers. + +struct pair { + typedef void (pair::*fp)(); + int first; + pair::fp second; + pair(const int& a, const pair::fp& b) : first(a), second(b) {} + void f(const int& a, const pair::fp& b) { first = a; second = b; } +}; + +void op() { + pair(5, pair::fp()); +} diff --git a/gcc/testsuite/g++.dg/opt/bool1.C b/gcc/testsuite/g++.dg/opt/bool1.C new file mode 100644 index 00000000000..78cdebe32aa --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/bool1.C @@ -0,0 +1,25 @@ +// PR opt/13869 +// { dg-do run } +// { dg-options "-O2" } + +extern "C" void abort (); + +int test () +{ + bool my_bool = true; + for (int i = 0; i < 10; ++i) + { + if (!my_bool) + ; + else + my_bool = false; + }; + return my_bool; +} + +int main () +{ + if (test ()) + abort (); + return 0; +} diff --git a/gcc/testsuite/g++.dg/opt/cfg4.C b/gcc/testsuite/g++.dg/opt/cfg4.C new file mode 100644 index 00000000000..94522ed4171 --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/cfg4.C @@ -0,0 +1,45 @@ +// PR optimization/13067 +// Origin: <bryner@brianryner.com> + +// This used to fail on the tree-ssa because of "out-of-ssa" +// We might have a valid variable, but not a valid value when trying to find +// useless statements created by out-of-ssa translation. In this case +// val will be set to null, then later dereferenced. Bad. + +// { dg-do compile } +// { dg-options "-Os" } + + + +struct Iterator +{ + Iterator operator++(); +}; + +void GetChar(char* aChar); + +void foo(char aChar) +{ + char quote; + Iterator end; + + while (1) { + if (aChar == '"') + GetChar(&aChar); + + switch (aChar) { + case 'a': + ++end; + if (quote) { + if (quote == aChar) { + quote = 0; + } + } else { + quote = aChar; + } + } + } +} + + + diff --git a/gcc/testsuite/g++.dg/opt/crash1.C b/gcc/testsuite/g++.dg/opt/crash1.C new file mode 100644 index 00000000000..3526df1ddc9 --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/crash1.C @@ -0,0 +1,14 @@ +// PR opt/13681 +// Here we have an out-of-range array index. We should not abort +// trying to resolve the indirection back to an object. + +struct X { + double values[1]; + double & foo (const unsigned int index) { return values[index]; } +}; + +void foo() { + double d; + X h1; + h1.foo(1) = d; +} diff --git a/gcc/testsuite/g++.dg/opt/inline7.C b/gcc/testsuite/g++.dg/opt/inline7.C new file mode 100644 index 00000000000..7a873b01a31 --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/inline7.C @@ -0,0 +1,7 @@ +// PR c++/13543 +// { dg-do compile } +// { dg-options "-O3" } + +struct basic_string { basic_string(const basic_string&); }; +basic_string operator+(const basic_string& lhs, char); +void dumpNode(basic_string start) { dumpNode(start + 'a'); } diff --git a/gcc/testsuite/g++.dg/opt/nothrow1.C b/gcc/testsuite/g++.dg/opt/nothrow1.C new file mode 100644 index 00000000000..fb6c6040408 --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/nothrow1.C @@ -0,0 +1,24 @@ +// Test that the nothrow optimization works properly. +// { dg-do compile } +// { dg-options "-O -fdump-tree-optimized" } + +extern void blah() throw(); + +int i, j, k; + +int main() +{ + try + { + ++i; + blah(); + ++j; + } + catch (...) + { + return 42; + } +} + +// The catch block should be optimized away. +// { dg-final { scan-tree-dump-times "42" 0 "optimized" } } diff --git a/gcc/testsuite/g++.dg/opt/static4.C b/gcc/testsuite/g++.dg/opt/static4.C new file mode 100644 index 00000000000..87e11b02756 --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/static4.C @@ -0,0 +1,15 @@ +// PR 13898 +// Make sure the two X variables get assigned unique assembler names +// if they are promoted to static storage. + +// { dg-do compile } + +int g(int i) { + if (i<1) { + const int x[3] = { 1,2,3 }; + return x[i]; + } else { + const int x[3] = { 4,5,6 }; + return x[i]; + } +} diff --git a/gcc/testsuite/g++.dg/parse/crash10.C b/gcc/testsuite/g++.dg/parse/crash10.C index 878139fa0de..8212fcb5b29 100644 --- a/gcc/testsuite/g++.dg/parse/crash10.C +++ b/gcc/testsuite/g++.dg/parse/crash10.C @@ -5,6 +5,8 @@ // PR c++ 10953. ICE +// { dg-bogus "" "" { target *-*-* } 14 } + class { typename:: // { dg-error "" "" } diff --git a/gcc/testsuite/g++.dg/tree-ssa/20040317-1.C b/gcc/testsuite/g++.dg/tree-ssa/20040317-1.C new file mode 100644 index 00000000000..e2f3dcdceb8 --- /dev/null +++ b/gcc/testsuite/g++.dg/tree-ssa/20040317-1.C @@ -0,0 +1,38 @@ +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +/* Test provided by Brian Ryner in PR 14511. The alias analyzer was + not handling structures containing arrays properly. In this case, + the static cast was introducing two assignments of the form + + this_6->_vptr.IFoo = &_ZTV4IFoo[2]; + this_4->_vptr.IFoo = &_ZTV3Bar[2]; + + which were not considered to alias each other because the alias + analyzer was not computing a proper pointer to array elements. + Another related bug was the type based alias analyzer not computing + alias relations to _ZTV4IFoo and _ZTV3Bar. Since those variables + are read-only, it was disregarding alias information for them. + So, the memory tags for the two 'this' variables were not being + marked as aliased with these variables. Resulting in the two + assignments not aliasing each other. + + This was causing the optimizers to generate a call to the virtual + method Foo() instead of the overloaded version. */ + +struct IFoo +{ + virtual void Foo() = 0; +}; + +struct Bar : IFoo +{ + void Foo() { } +}; + +int main(int argc, char **argv) +{ + Bar* b = new Bar(); + static_cast<IFoo*>(b)->Foo(); + return 0; +} diff --git a/gcc/testsuite/g++.dg/tree-ssa/nothrow-1.C b/gcc/testsuite/g++.dg/tree-ssa/nothrow-1.C new file mode 100644 index 00000000000..6bd092977cd --- /dev/null +++ b/gcc/testsuite/g++.dg/tree-ssa/nothrow-1.C @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-cfg" } */ +double a; +void t() +{ + a=1; +} +void t1(void); +void abort(void); + +void q() +{ + try { + t(); + } + catch (...) {abort();} +} +/* We shouldnotice nothrow attribute. */ +/* { dg-final { scan-tree-dump-times "exception" 0 "cfg"} } */ diff --git a/gcc/testsuite/g++.dg/tree-ssa/tree-ssa.exp b/gcc/testsuite/g++.dg/tree-ssa/tree-ssa.exp new file mode 100644 index 00000000000..4788baa7838 --- /dev/null +++ b/gcc/testsuite/g++.dg/tree-ssa/tree-ssa.exp @@ -0,0 +1,36 @@ +# Copyright (C) 2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# GCC testsuite that uses the `dg.exp' driver. + +# Load support procs. +load_lib g++-dg.exp + +# If a testcase doesn't have special options, use these. +global DEFAULT_CXXFLAGS +if ![info exists DEFAULT_CXXFLAGS] then { + set DEFAULT_CXXFLAGS " -ansi -pedantic-errors" +} + +# Initialize `dg'. +dg-init + +# Main loop. +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[CS\]]] \ + "" $DEFAULT_CXXFLAGS + +# All done. +dg-finish diff --git a/gcc/testsuite/g++.dg/warn/Wswitch-1.C b/gcc/testsuite/g++.dg/warn/Wswitch-1.C index e9fcb581817..4f44e12576e 100644 --- a/gcc/testsuite/g++.dg/warn/Wswitch-1.C +++ b/gcc/testsuite/g++.dg/warn/Wswitch-1.C @@ -19,17 +19,17 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, case 4: return 3; default: break; } - switch (ei) - { /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" { target *-*-* } 24 } */ - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ + switch (ei) /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ + { /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" { target *-*-* } 22 } */ + } switch (ej) { default: break; } - switch (ek) + switch (ek) /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ { case e1: return 1; - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ + } switch (el) { case e1: return 1; @@ -50,8 +50,8 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, { case e1: return 1; case e2: return 2; - case 3: return 3; - } /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + case 3: return 3; /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + } switch (ep) { case e1: return 1; diff --git a/gcc/testsuite/g++.dg/warn/Wswitch-2.C b/gcc/testsuite/g++.dg/warn/Wswitch-2.C index b151e2310c7..9bc7d022b46 100644 --- a/gcc/testsuite/g++.dg/warn/Wswitch-2.C +++ b/gcc/testsuite/g++.dg/warn/Wswitch-2.C @@ -13,19 +13,19 @@ foo (enum e ei, int j) case e3: return 2; case e4: return 3; } /* No warning here since e2 has the same value as e3. */ - switch (ei) + switch (ei) /* { dg-warning "enumeration value `e4' not handled in switch" "enum e4" } */ { case e1: return 1; case e2: return 2; - } /* { dg-warning "enumeration value `e4' not handled in switch" "enum e4" } */ + } switch ((int) ei) { case e1: return 1; } /* No warning here since switch condition was cast to int. */ - switch ((enum e) j) + switch ((enum e) j) /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ { case e2: return 1; case e4: return 2; - } /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ + } return 0; } diff --git a/gcc/testsuite/g++.dg/warn/Wunused-5.C b/gcc/testsuite/g++.dg/warn/Wunused-5.C index 06d1a0516bc..8a8d9d280fc 100644 --- a/gcc/testsuite/g++.dg/warn/Wunused-5.C +++ b/gcc/testsuite/g++.dg/warn/Wunused-5.C @@ -1,13 +1,19 @@ -// PR c++/14199 -// { dg-options "-W -Wall -Wunused" } - -struct X { - static void foo (); -}; - -template <typename T> -void foo (const T &t) { - t.foo(); -} +/* PR opt/14288 */ +/* { dg-do compile } */ +/* { dg-options "-O -Wall" } */ + +volatile int sink; +extern int foo(int); + +struct S +{ + int x; -template void foo (const X &); + S() { x = foo(0); } + ~S() { sink = x; } +}; + +int test(bool p) +{ + return p ? foo(S().x) : 0; /* { dg-bogus "uninitialized" } */ +} diff --git a/gcc/testsuite/g++.dg/warn/noeffect5.C b/gcc/testsuite/g++.dg/warn/noeffect5.C new file mode 100644 index 00000000000..f0f4e74109a --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/noeffect5.C @@ -0,0 +1,8 @@ +/* PR middle-end/13325 */ +/* { dg-do compile } */ +/* { dg-options "-Wall" } */ + +void *memcpy(void *dest, const void *src, __SIZE_TYPE__ n); +void f (void *dest, const void *src) { + memcpy (dest, src, 0); +} diff --git a/gcc/testsuite/g++.old-deja/g++.ext/arrnew2.C b/gcc/testsuite/g++.old-deja/g++.ext/arrnew2.C index 84063834f1d..93d15d08d90 100644 --- a/gcc/testsuite/g++.old-deja/g++.ext/arrnew2.C +++ b/gcc/testsuite/g++.old-deja/g++.ext/arrnew2.C @@ -1,4 +1,8 @@ -// { dg-do assemble } -// { dg-options "" } +// { dg-do run { xfail *-*-* } } +// { dg-options "-w -fpermissive" } -int *foo = new int[1](0); // { dg-bogus "" } +int *foo = new int[1](42); // { dg-bogus "" } +int main () +{ + return foo[0] != 42; +} diff --git a/gcc/testsuite/g++.old-deja/g++.martin/new1.C b/gcc/testsuite/g++.old-deja/g++.martin/new1.C index c7951654c26..502c4f42ad0 100644 --- a/gcc/testsuite/g++.old-deja/g++.martin/new1.C +++ b/gcc/testsuite/g++.old-deja/g++.martin/new1.C @@ -71,8 +71,8 @@ void test1() func(new B(A(10).addr())); }catch(int){ } - CHECK(new_done==1); - CHECK(ctor_done==2); + CHECK(ctor_done==1); + CHECK(new_done==2); CHECK(func_done==3); CHECK(dtor_done==4); CHECK(delete_done==0); @@ -86,10 +86,10 @@ void test2() func(new B(A(10).addr())); }catch(int){ } - CHECK(new_done==1); - CHECK(ctor_done==0); + CHECK(ctor_done==1); + CHECK(new_done==2); CHECK(func_done==0); - CHECK(dtor_done==0); + CHECK(dtor_done==3); CHECK(delete_done==0); } @@ -101,11 +101,11 @@ void test3() func(new B(A(10).addr())); }catch(int){ } - CHECK(new_done==1); - CHECK(ctor_done==2); + CHECK(new_done==0); + CHECK(ctor_done==1); CHECK(func_done==0); CHECK(dtor_done==0); - CHECK(delete_done==3); + CHECK(delete_done==0); } int main() diff --git a/gcc/testsuite/g++.old-deja/g++.robertl/eb58.C b/gcc/testsuite/g++.old-deja/g++.robertl/eb58.C index 566cf9a7831..04ec92a30af 100644 --- a/gcc/testsuite/g++.old-deja/g++.robertl/eb58.C +++ b/gcc/testsuite/g++.old-deja/g++.robertl/eb58.C @@ -1,5 +1,5 @@ // { dg-do run } -// { dg-options "" } +// { dg-options "-w -fpermissive" } // Test for g++ array init extension class A { diff --git a/gcc/testsuite/g++.old-deja/g++.robertl/eb63.C b/gcc/testsuite/g++.old-deja/g++.robertl/eb63.C index a1601f80f9f..a49fb02641c 100644 --- a/gcc/testsuite/g++.old-deja/g++.robertl/eb63.C +++ b/gcc/testsuite/g++.old-deja/g++.robertl/eb63.C @@ -1,5 +1,5 @@ // { dg-do run } -// { dg-options "" } +// { dg-options "-w -fpermissive" } //This uses GNU extensions, so disable -ansi #include <stdio.h> #include <stdlib.h> diff --git a/gcc/testsuite/gcc.c-torture/compile/20010516-1.c b/gcc/testsuite/gcc.c-torture/compile/20010516-1.c deleted file mode 100644 index 7732812cfb1..00000000000 --- a/gcc/testsuite/gcc.c-torture/compile/20010516-1.c +++ /dev/null @@ -1,5 +0,0 @@ -foo() -{ - char d; - asm volatile ( "" :: "m"(&d)); -} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030310-1.c b/gcc/testsuite/gcc.c-torture/compile/20030310-1.c new file mode 100644 index 00000000000..0e89e0bfca2 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030310-1.c @@ -0,0 +1,13 @@ +static inline void +foo (char accept) +{ + char s; + while (s == accept) ; +} + +static void +bar (void) +{ + char ch; + foo (ch); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030405-1.c b/gcc/testsuite/gcc.c-torture/compile/20030405-1.c index 2e61f1fa3ff..f84e606c045 100644 --- a/gcc/testsuite/gcc.c-torture/compile/20030405-1.c +++ b/gcc/testsuite/gcc.c-torture/compile/20030405-1.c @@ -1,58 +1,30 @@ -/* PR optimization/10024 */ -extern int *allegro_errno; -typedef long fixed; -extern inline int -fixfloor (fixed x) -{ - if (x >= 0) - return (x >> 16); - else - return ~((~x) >> 16); -} -extern inline int -fixtoi (fixed x) -{ - return fixfloor (x) + ((x & 0x8000) >> 15); -} -extern inline fixed -ftofix (double x) -{ - if (x > 32767.0) - { - *allegro_errno = 34; - return 0x7FFFFFFF; - } - if (x < -32767.0) - { - *allegro_errno = 34; - return -0x7FFFFFFF; - } - return (long) (x * 65536.0 + (x < 0 ? -0.5 : 0.5)); -} -extern inline double -fixtof (fixed x) -{ - return (double) x / 65536.0; -} -extern inline fixed -fixdiv (fixed x, fixed y) +/* When compiled with -pedantic, this program will cause an ICE when the + constant propagator tries to set the value of *str to UNDEFINED. + + This happens because *str is erroneously considered as a store alias. + The aliasing code is then making *str an alias leader for its alias set + and when the PHI node at the end of the while() is visited the first + time, CCP will try to assign it a value of UNDEFINED, but the default + value for *str is a constant. */ +typedef unsigned int size_t; +size_t strlength (const char * const); +char foo(); + +static const char * const str = "mingo"; + +bar() { - if (y == 0) + size_t c; + char *x; + + c = strlength (str); + while (c < 10) { - *allegro_errno = 34; - return (x < 0) ? -0x7FFFFFFF : 0x7FFFFFFF; + if (c > 5) + *x = foo (); + if (*x < 'a') + break; } - else - return ftofix (fixtof (x) / fixtof (y)); -} -extern inline fixed -itofix (int x) -{ - return x << 16; -} -int -foo (int n) -{ - return fixtoi (fixdiv (itofix (512), itofix (n))); + return *x == '3'; } diff --git a/gcc/testsuite/gcc.c-torture/compile/20030405-1.x b/gcc/testsuite/gcc.c-torture/compile/20030405-1.x new file mode 100644 index 00000000000..3dbbbda51b7 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030405-1.x @@ -0,0 +1,3 @@ +# This test was found to fail only when -pedantic is used. +set options "-pedantic" +return 0 diff --git a/gcc/testsuite/gcc.c-torture/compile/20030416-1.c b/gcc/testsuite/gcc.c-torture/compile/20030416-1.c new file mode 100644 index 00000000000..c3d18b68281 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030416-1.c @@ -0,0 +1,16 @@ +void foo(int x) +{ + if (x > 3) + {;} + else + bar(); + x = 9; +} + +main() +{ + int j; + + foo(j); + return j; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030530-1.c b/gcc/testsuite/gcc.c-torture/compile/20030530-1.c new file mode 100644 index 00000000000..b479ea22b1d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030530-1.c @@ -0,0 +1,23 @@ +union tree_node; +typedef union tree_node *tree; +struct tree_common +{ + tree type; + unsigned lang_flag_0 : 1; +}; +union tree_node +{ + struct tree_common common; +}; +static void +java_check_regular_methods (tree class_decl) +{ + int saw_constructor = class_decl->common.type->common.lang_flag_0; + tree class = class_decl->common.type; + for (;;) + { + if (class) + if (class_decl->common.type) + bar (class); + } +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030530-3.c b/gcc/testsuite/gcc.c-torture/compile/20030530-3.c new file mode 100644 index 00000000000..0a93d2f13fa --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030530-3.c @@ -0,0 +1,16 @@ +struct tree_decl +{ + unsigned in_system_header_flag:1; +}; +union tree_node +{ + struct tree_decl decl; +}; +typedef union tree_node *tree; +static int +redeclaration_error_message (olddecl) + tree olddecl; +{ + if (({olddecl;})->decl.in_system_header_flag) + ; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030716-1.c b/gcc/testsuite/gcc.c-torture/compile/20030716-1.c new file mode 100644 index 00000000000..ceb4b6171e9 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030716-1.c @@ -0,0 +1,7 @@ +void baz(int i); + +void foo(int i, int A[i+1]) +{ + int j=A[i]; + void bar() { baz(A[i]); } +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030823-1.c b/gcc/testsuite/gcc.c-torture/compile/20030823-1.c new file mode 100644 index 00000000000..89a3ea50a7f --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030823-1.c @@ -0,0 +1,18 @@ +struct A +{ + int a; +}; + +int foo (struct A *a) +{ + static int c = 30; + int x; + + a->a = c; + /* Dominator optimizations will replace the use of 'a->a' with 'c', but + they won't copy the virtual operands for 'c' from its originating + statement. This exposes symbol 'c' without a correct SSA version + number. */ + x = a->a; + return x; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030902-1.c b/gcc/testsuite/gcc.c-torture/compile/20030902-1.c new file mode 100644 index 00000000000..443b43921b8 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030902-1.c @@ -0,0 +1,37 @@ +typedef unsigned int size_t; +typedef unsigned long int reg_syntax_t; +struct re_pattern_buffer +{ + unsigned char *buffer; +}; +typedef enum +{ + jump, + jump_n, +} re_opcode_t; +static int +foo (bufp) + struct re_pattern_buffer *bufp; +{ + int mcnt; + unsigned char *p = bufp->buffer; + switch (((re_opcode_t) * p++)) + { + unconditional_jump: + ; + /* This test case caused an ICE because the statement insertion + routines were failing to update basic block boundaries. */ + case jump: + do + { + (mcnt) = *(p) & 0377; + } + while (0); + (p) += 2; + p += mcnt; + case jump_n: + (mcnt) = *(p + 2) & 0377; + if (mcnt) + goto unconditional_jump; + } +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20030910-1.c b/gcc/testsuite/gcc.c-torture/compile/20030910-1.c new file mode 100644 index 00000000000..9fad109208c --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030910-1.c @@ -0,0 +1,11 @@ +/* The gimplifier was getting confused when taking the real or + imaginary component of a complex rvalue. */ + +void test() +{ + __complex double dc; + double d; + + d = __real (dc * dc); +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/20030917-1.c b/gcc/testsuite/gcc.c-torture/compile/20030917-1.c new file mode 100644 index 00000000000..38b6598af14 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20030917-1.c @@ -0,0 +1,18 @@ +typedef struct string STR; +typedef struct atbl ARRAY; +struct string { + unsigned char str_pok; +}; +struct atbl { + int ary_fill; +}; +blah(size,strp) +register int size; +register STR **strp; +{ + register ARRAY *ar; + ar->ary_fill = size - 1; + while (size--) + (*strp)->str_pok &= ~128; +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/20031124-1.c b/gcc/testsuite/gcc.c-torture/compile/20031124-1.c new file mode 100644 index 00000000000..102e71aa84f --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031124-1.c @@ -0,0 +1,8 @@ +/* PR 13143 */ + +int f (void *ptr) +{ + extern char const stop[]; + return ptr >= (void *) &stop; +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/20031125-1.c b/gcc/testsuite/gcc.c-torture/compile/20031125-1.c new file mode 100644 index 00000000000..735a20bc241 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031125-1.c @@ -0,0 +1,36 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ +short *_offsetTable; +/* This tests to make sure PRE splits the entry block ->block 0 edge + when there are multiple block 0 predecessors. + This is done so that we don't end up with an insertion on the + entry block -> block 0 edge which would require a split at insertion + time. + PR 13163. */ +void proc4WithoutFDFE(char *dst, const char *src, int next_offs, int bw, + int bh, int pitch) +{ + do { + int i = bw; + int code = *src++; + int x, l; + int length = *src++ + 1; + + for (l = 0; l < length; l++) { + int x; + + for (x = 0; x < 4; x++) ; + if (i == 0) + dst += pitch * 3; + } + char *dst2 = dst + _offsetTable[code] + next_offs; + + for (x = 0; x < 4; x++) { + int j = 0; + (dst + pitch * x)[j] = (dst2 + pitch * x)[j]; + } + dst += pitch * 3; + } while (--bh); +} + + diff --git a/gcc/testsuite/gcc.c-torture/compile/20031125-2.c b/gcc/testsuite/gcc.c-torture/compile/20031125-2.c new file mode 100644 index 00000000000..2af8a021175 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031125-2.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ +struct BlobSpan { + int right; +}; +/* This test makes sure we don't accidently cause a bad insertion to occur + by choosing the wrong variable name so that we end up with a use not + dominated by a def. */ +void render_blob_line(struct BlobSpan blobdata) { + int buf[4 * 8]; + int *data = buf; + int i, n = 0; + if (blobdata.right) + n++; + if (n) + for (; i < 2 * n;) + data[i] = 0; + n *= 2; + for (; n;) ; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20031203-1.c b/gcc/testsuite/gcc.c-torture/compile/20031203-1.c new file mode 100644 index 00000000000..7827eb9066f --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031203-1.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ +void make_file_symbol_completion_list (char *); +/* This tests to make sure PRE doesn't choose the wrong name when + inserting phi nodes. Otherwise, we get uses that aren't dominated + by defs. + PR 13177. */ +void location_completer (char *text) +{ + char *p, *symbol_start = text; + for (p = text; *p != '\0'; ++p) { + if (*p == '\\' && p[1] == '\'') + p++; + else if (*p == ':') + symbol_start = p + 1; + else + symbol_start = p + 1; + make_file_symbol_completion_list(symbol_start); + } +} + + diff --git a/gcc/testsuite/gcc.c-torture/compile/20031203-2.c b/gcc/testsuite/gcc.c-torture/compile/20031203-2.c new file mode 100644 index 00000000000..47f561bae77 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031203-2.c @@ -0,0 +1,6 @@ +/* Don't ICE on stupid user tricks. */ + +int foo(int bar) +{ + return (&bar)[-1]; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20031203-3.c b/gcc/testsuite/gcc.c-torture/compile/20031203-3.c new file mode 100644 index 00000000000..341a9df984a --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20031203-3.c @@ -0,0 +1,7 @@ +/* Don't ICE on user silliness. GCC 3.4 and before accepts this without + comment; 3.5 warns. Perhaps eventually we'll declare this an error. */ + +void bar (void) +{ + ({}); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040219-1.c b/gcc/testsuite/gcc.c-torture/compile/20040219-1.c new file mode 100644 index 00000000000..d3bc9272b64 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040219-1.c @@ -0,0 +1 @@ +double foo() { return __builtin_isgreater(0.,0.); } diff --git a/gcc/testsuite/gcc.c-torture/compile/20040220-1.c b/gcc/testsuite/gcc.c-torture/compile/20040220-1.c new file mode 100644 index 00000000000..8a4a5ba6d0f --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040220-1.c @@ -0,0 +1,16 @@ +/* PR 14194 */ + +int irqs; + +static inline __attribute__((always_inline)) +int kstat_irqs (void) { + int i, sum = 0; + for (i = 0; i < 1; i++) + if (__builtin_expect(i, 0)) + sum += irqs; + return sum; +} + +int show_interrupts (void) { + return kstat_irqs (); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040303-1.c b/gcc/testsuite/gcc.c-torture/compile/20040303-1.c new file mode 100644 index 00000000000..6b2452adab9 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040303-1.c @@ -0,0 +1,16 @@ +typedef struct input { + struct input *next; +} input_t; +static input_t *inputs = (input_t *)((void *)0); +void +RemoveInput(unsigned long id) +{ + input_t *ip; + input_t *prev; + while (1) + if (ip == (input_t *)id) + break; + if (ip == (input_t *)((void *)0)) + return; + prev->next = ip->next; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040303-2.c b/gcc/testsuite/gcc.c-torture/compile/20040303-2.c new file mode 100644 index 00000000000..6751620a43a --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040303-2.c @@ -0,0 +1,23 @@ +void abort(void); +int x, y; +void init_xy(void); +void +test4(void) +{ + init_xy(); + _Bool iftemp0; + int x1 = x; + _Bool iftemp1; + x1++; + if (x1 != 3) + { + iftemp1 = 1; + goto endfirstif; + } + iftemp1 = 0; + endfirstif: + iftemp0 = iftemp1; + if (iftemp0) + abort(); +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/20040304-1.c b/gcc/testsuite/gcc.c-torture/compile/20040304-1.c index 146d42f23d6..ee277d799a4 100644 --- a/gcc/testsuite/gcc.c-torture/compile/20040304-1.c +++ b/gcc/testsuite/gcc.c-torture/compile/20040304-1.c @@ -1,45 +1,20 @@ -/* PR optimization/14235 */ -/* Origin: <senor_fjord@yahoo.com> */ - -typedef signed char int8_t; -typedef short int16_t; -typedef int int32_t; -typedef unsigned long long uint64_t; - -static const uint64_t LOW_BYTE_MASK = 0x00000000000000ffULL; -static const uint64_t HIGH_BYTE_MASK = 0x000000000000ff00ULL; -static const uint64_t WORD_MASK = 0x000000000000ffffULL; -static const uint64_t DWORD_MASK = 0x00000000ffffffffULL; - -extern uint64_t *srca_mask; -extern int *assert_thrown; - -void foo() +void +cpplib_macroExpand (char * pfile) { - uint64_t tempA = 0; /* actually a bunch of code to set A */ - uint64_t tempB = 0; /* actually a bunch of code to set B */ - - /* cast A to right size */ - tempA = (((*srca_mask == LOW_BYTE_MASK) || - (*srca_mask == HIGH_BYTE_MASK)) ? - ((int8_t)tempA) : - ((*srca_mask == WORD_MASK) ? - ((int16_t)tempA) : - ((*srca_mask == DWORD_MASK) ? - ((int32_t)tempA) : - tempA))); - - /* cast B to right size */ - tempB = (((*srca_mask == LOW_BYTE_MASK) || - (*srca_mask == HIGH_BYTE_MASK)) ? - ((int8_t)tempB) : - ((*srca_mask == WORD_MASK) ? - ((int16_t)tempB) : - ((*srca_mask == DWORD_MASK) ? - ((int32_t)tempB) : - tempB))); - - if ((int) tempA > (int) tempB) { - *assert_thrown = 1; - } + int nargs; + int rest_args; + int token = -1; + rest_args = 0; + do + { + if (rest_args != 0) + continue; + if (nargs == 0) + { + rest_args = 1; + token = macarg (pfile, rest_args); + } + } + while (token == 20); } + diff --git a/gcc/testsuite/gcc.c-torture/compile/20040309-1.c b/gcc/testsuite/gcc.c-torture/compile/20040309-1.c new file mode 100644 index 00000000000..df8390f207b --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040309-1.c @@ -0,0 +1,20 @@ +static const char default_tupleseps[] = ", \t"; + + +fubar (tupleseps) + const char *tupleseps; +{ + char *kp, *sp; + const char *septmp; + const char *tseplist; + tseplist = (tupleseps) ? tupleseps : default_tupleseps; + while (kp) + { + if (*tseplist) + septmp = tseplist; + bar (*septmp); + if (*tseplist) + if (*kp) + ; + } +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040310-1.c b/gcc/testsuite/gcc.c-torture/compile/20040310-1.c new file mode 100644 index 00000000000..f0c85f0ada5 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040310-1.c @@ -0,0 +1,10 @@ +void I_wacom () +{ + char buffer[50], *p; + int RequestData (char *cmd) + { + p = buffer; + foo (buffer); + } + RequestData (0); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040317-1.c b/gcc/testsuite/gcc.c-torture/compile/20040317-1.c new file mode 100644 index 00000000000..4a3455115cb --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040317-1.c @@ -0,0 +1,4 @@ +int String2Array(int len, char strarr[][len]) +{ + strarr[0]; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040317-2.c b/gcc/testsuite/gcc.c-torture/compile/20040317-2.c new file mode 100644 index 00000000000..3c8ee2b8ec5 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040317-2.c @@ -0,0 +1,25 @@ +typedef struct _ScaleRec *ScaleWidget; +typedef struct +{ + short *x; + unsigned short *width; +} Table; +typedef struct +{ + Table table; +} ScalePart; +typedef struct _ScaleRec +{ + ScalePart scale; +} ScaleRec; +static int +FindPixel (ScaleWidget sw, short x, short y, + short * img_x, short * img_y, unsigned long * img_pixel) +{ + if (sw->scale.table.x[(int) *img_x] + + (short) sw->scale.table.width[(int) *img_x] < x) + { + ++*img_x; + return FindPixel (sw, x, y, img_x, img_y, img_pixel); + } +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040317-3.c b/gcc/testsuite/gcc.c-torture/compile/20040317-3.c new file mode 100644 index 00000000000..e6982c3e3b3 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040317-3.c @@ -0,0 +1,11 @@ +I_wacom () +{ + char buffer[50], *p; + int RequestData (char *cmd) + { + p = buffer; + foo (buffer); + } + RequestData (0); +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/20040323-1.c b/gcc/testsuite/gcc.c-torture/compile/20040323-1.c new file mode 100644 index 00000000000..c87e7dc70ba --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040323-1.c @@ -0,0 +1,11 @@ +/* PR 14694 */ +/* { dg-require-alias "" } */ + +extern unsigned int _rtld_local __attribute__ ((alias ("_rtld_global"))); + +unsigned int +_dl_start (void *arg) +{ + unsigned int elf_machine_rel () { return _rtld_local; } + return elf_machine_rel (); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040401-1.c b/gcc/testsuite/gcc.c-torture/compile/20040401-1.c new file mode 100644 index 00000000000..ee727a9b205 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040401-1.c @@ -0,0 +1,6 @@ +int __atomic_readv_replacement(unsigned char iov_len, int count, int i) { + unsigned char bytes = 0; + if ((unsigned char)((char)127 - bytes) < iov_len) + return 22; + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040415-1.c b/gcc/testsuite/gcc.c-torture/compile/20040415-1.c new file mode 100644 index 00000000000..1b1537a7ba6 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040415-1.c @@ -0,0 +1,5 @@ +int isdigit (int); +int f (const char *type) +{ + return isdigit ((unsigned char) *type++); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/20040415-2.c b/gcc/testsuite/gcc.c-torture/compile/20040415-2.c new file mode 100644 index 00000000000..e78e81e8cf8 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/20040415-2.c @@ -0,0 +1,7 @@ +int isascii (int); + +int f1 (const char *type) +{ + return isascii ((unsigned char) *type++); +} + diff --git a/gcc/testsuite/gcc.c-torture/compile/pr14730.c b/gcc/testsuite/gcc.c-torture/compile/pr14730.c new file mode 100644 index 00000000000..b4f36a9ae3c --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr14730.c @@ -0,0 +1,16 @@ +/* PR middle-end/14730 */ + +int t (char i) +{ + switch (i) + { + case 1: + case 7: + case 10: + case 14: + case 9: + case 256: + return 0; + } + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr15245.c b/gcc/testsuite/gcc.c-torture/compile/pr15245.c new file mode 100644 index 00000000000..d7d9051a1c1 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr15245.c @@ -0,0 +1,21 @@ +/* Testcase from <marcus@jet.franken.de> + PR optimization/15245 + This used to ICE as convert was used + in tree-ssa-phiopt which created non gimple + code. */ + +char *f(char *x, int flag) +{ + char *ret = (char*)0; + + + if( x > (char*)1 ) { + if(x) + return (char*)0; + } else { + if( flag & 1 ) + ret = (char*)1; + flag |= 2; + } + return ret; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20000603-1.c b/gcc/testsuite/gcc.c-torture/execute/20000603-1.c index 9c9f69baf04..4e31eee4563 100644 --- a/gcc/testsuite/gcc.c-torture/execute/20000603-1.c +++ b/gcc/testsuite/gcc.c-torture/execute/20000603-1.c @@ -1,5 +1,10 @@ +/* It is not clear whether this test is conforming. See DR#236 + http://wwwold.dkuug.dk/JTC1/SC22/WG14/www/docs/dr_236.htm. However, + there seems to be consensus that the presence of a union to aggregate + struct s1 and struct s2 should make it conforming. */ struct s1 { double d; }; struct s2 { double d; }; +union u { struct s1 x; struct s2 y; }; double f(struct s1 *a, struct s2 *b) { @@ -9,9 +14,9 @@ double f(struct s1 *a, struct s2 *b) int main() { - struct s1 a; - a.d = 0.0; - if (f (&a, (struct s2 *)&a) != 2.0) + union u a; + a.x.d = 0.0; + if (f (&a.x, &a.y) != 2.0) abort (); return 0; } diff --git a/gcc/testsuite/gcc.c-torture/execute/20020819-1.c b/gcc/testsuite/gcc.c-torture/execute/20020819-1.c new file mode 100644 index 00000000000..549da910cd4 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20020819-1.c @@ -0,0 +1,22 @@ +foo () +{ + return 0; +} + +main() +{ + int i, j, k, ccp_bad = 0; + + for (i = 0; i < 10; i++) + { + for (j = 0; j < 10; j++) + if (foo ()) + ccp_bad = 1; + + k = ccp_bad != 0; + if (k) + abort (); + } + + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20021113-1.c b/gcc/testsuite/gcc.c-torture/execute/20021113-1.c new file mode 100644 index 00000000000..420926d7548 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20021113-1.c @@ -0,0 +1,17 @@ +/* This program tests a data flow bug that would cause constant propagation + to propagate constants through function calls. */ + +foo (int *p) +{ + *p = 10; +} + +main() +{ + int *ptr = alloca (sizeof (int)); + *ptr = 5; + foo (ptr); + if (*ptr == 5) + abort (); + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20030403-1.c b/gcc/testsuite/gcc.c-torture/execute/20030403-1.c new file mode 100644 index 00000000000..cbf1351c4be --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030403-1.c @@ -0,0 +1,16 @@ +/* The non-destructive folder was always emitting >= when folding + comparisons to signed_max+1. */ + +#include <limits.h> + +int +main () +{ + unsigned long count = 8; + + if (count > INT_MAX) + abort (); + + return (0); +} + diff --git a/gcc/testsuite/gcc.c-torture/execute/20030404-1.c b/gcc/testsuite/gcc.c-torture/execute/20030404-1.c new file mode 100644 index 00000000000..1dd1ec09906 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030404-1.c @@ -0,0 +1,23 @@ +/* This exposed a bug in tree-ssa-ccp.c. Since 'j' and 'i' are never + defined, CCP was not traversing the edges out of the if(), which caused + the PHI node for 'k' at the top of the while to only be visited once. + This ended up causing CCP to think that 'k' was the constant '1'. */ +main() +{ + int i, j, k; + + k = 0; + while (k < 10) + { + k++; + if (j > i) + j = 5; + else + j =3; + } + + if (k != 10) + abort (); + + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20030501-1.c b/gcc/testsuite/gcc.c-torture/execute/20030501-1.c new file mode 100644 index 00000000000..f47dc291bd3 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030501-1.c @@ -0,0 +1,17 @@ +int +main (int argc, char **argv) +{ + int size = 10; + + { + int retframe_block() + { + return size + 5; + } + + if (retframe_block() != 15) + abort (); + exit (0); + + } +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20030828-1.c b/gcc/testsuite/gcc.c-torture/execute/20030828-1.c new file mode 100644 index 00000000000..e8c1f0195df --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030828-1.c @@ -0,0 +1,18 @@ +const int *p; + +int bar (void) +{ + return *p + 1; +} + +main () +{ + /* Variable 'i' is never used but it's aliased to a global pointer. The + alias analyzer was not considering that 'i' may be used in the call to + bar(). */ + const int i = 5; + p = &i; + if (bar() != 6) + abort (); + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20030828-2.c b/gcc/testsuite/gcc.c-torture/execute/20030828-2.c new file mode 100644 index 00000000000..0c3a195e626 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030828-2.c @@ -0,0 +1,28 @@ +struct rtx_def +{ + int code; +}; + +main() +{ + int tmp[2]; + struct rtx_def *r, s; + int *p, *q; + + /* The alias analyzer was creating the same memory tag for r, p and q + because 'struct rtx_def *' is type-compatible with 'int *'. However, + the alias set of 'int[2]' is not the same as 'int *', so variable + 'tmp' was deemed not aliased with anything. */ + r = &s; + r->code = 39; + + /* If 'r' wasn't declared, then q and tmp would have had the same memory + tag. */ + p = tmp; + q = p + 1; + *q = 0; + tmp[1] = 39; + if (*q != 39) + abort (); + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20030903-1.c b/gcc/testsuite/gcc.c-torture/execute/20030903-1.c new file mode 100644 index 00000000000..95dad576f2d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030903-1.c @@ -0,0 +1,21 @@ +/* Test that we don't let stmt.c think that the enumeration's values are + the entire set of possibilities. Such an assumption is false for C, + but true for other languages. */ + +enum X { X1 = 1, X2, X3, X4 }; +static volatile enum X test = 0; +static void y(int); + +int main() +{ + switch (test) + { + case X1: y(1); break; + case X2: y(2); break; + case X3: y(3); break; + case X4: y(4); break; + } + return 0; +} + +static void y(int x) { abort (); } diff --git a/gcc/testsuite/gcc.c-torture/execute/20030909-1.c b/gcc/testsuite/gcc.c-torture/execute/20030909-1.c new file mode 100644 index 00000000000..2f149857fc7 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030909-1.c @@ -0,0 +1,35 @@ +void abort (); +void exit (int); + +void test(int x, int y) +{ + if (x == y) + abort (); +} + +void foo(int x, int y) +{ + if (x == y) + goto a; + else + { +a:; + if (x == y) + goto b; + else + { +b:; + if (x != y) + test (x, y); + } + } +} + +int main(void) +{ + foo (0, 0); + + exit (0); +} + + diff --git a/gcc/testsuite/gcc.c-torture/execute/20030910-1.c b/gcc/testsuite/gcc.c-torture/execute/20030910-1.c new file mode 100644 index 00000000000..6c849134a9b --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030910-1.c @@ -0,0 +1,13 @@ +/* The gimplifier was inserting unwanted temporaries for REALPART_EXPR + nodes. These need to be treated like a COMPONENT_REF so their address can + be taken. */ + +int main() +{ + __complex double dc; + double *dp = &(__real dc); + *dp = 3.14; + if ((__real dc) != 3.14) abort(); + exit (0); +} + diff --git a/gcc/testsuite/gcc.c-torture/execute/20030913-1.c b/gcc/testsuite/gcc.c-torture/execute/20030913-1.c new file mode 100644 index 00000000000..5e33f50f560 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20030913-1.c @@ -0,0 +1,26 @@ +/* Assignments via pointers pointing to global variables were being killed + by SSA-DCE. Test contributed by Paul Brook <paul@nowt.org> */ + +int glob; + +void +fn2(int ** q) +{ + *q = &glob; +} + +void test() +{ + int *p; + + fn2(&p); + + *p=42; +} + +int main() +{ + test(); + if (glob != 42) abort(); + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20031010-1.c b/gcc/testsuite/gcc.c-torture/execute/20031010-1.c new file mode 100644 index 00000000000..54457f964c3 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20031010-1.c @@ -0,0 +1,34 @@ +/* A reminder to process ops in generate_expr_as_of_bb exactly once. */ + +long __attribute__((noinline)) +foo (long ct, long cf, _Bool p1, _Bool p2, _Bool p3) +{ + long diff; + + diff = ct - cf; + + if (p1) + { + if (p2) + { + if (p3) + { + long tmp = ct; + ct = cf; + cf = tmp; + } + diff = ct - cf; + } + + return diff; + } + + abort (); +} + +int main () +{ + if (foo(2, 3, 1, 1, 1) == 0) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20031211-1.c b/gcc/testsuite/gcc.c-torture/execute/20031211-1.c new file mode 100644 index 00000000000..2361509a096 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20031211-1.c @@ -0,0 +1,13 @@ +struct a { unsigned int bitfield : 1; }; + +unsigned int x; + +main() +{ + struct a a = {0}; + x = 0xbeef; + a.bitfield |= x; + if (a.bitfield != 1) + abort (); + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20031211-2.c b/gcc/testsuite/gcc.c-torture/execute/20031211-2.c new file mode 100644 index 00000000000..555b17d9ac6 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20031211-2.c @@ -0,0 +1,19 @@ +struct a +{ + unsigned int bitfield : 3; +}; + +int main() +{ + struct a a; + + a.bitfield = 131; + foo (a.bitfield); + exit (0); +} + +foo(unsigned int z) +{ + if (z != 3) + abort (); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20040319-1.c b/gcc/testsuite/gcc.c-torture/execute/20040319-1.c new file mode 100644 index 00000000000..357932d9b24 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20040319-1.c @@ -0,0 +1,17 @@ +int +blah (int zzz) +{ + int foo; + if (zzz >= 0) + return 1; + foo = (zzz >= 0 ? (zzz) : -(zzz)); + return foo; +} + +main() +{ + if (blah (-1) != 1) + abort (); + else + exit (0); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20040423-1.c b/gcc/testsuite/gcc.c-torture/execute/20040423-1.c new file mode 100644 index 00000000000..ace797e79d3 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20040423-1.c @@ -0,0 +1,30 @@ +int +sub1 (int i, int j) +{ + typedef struct + { + int c[i+2]; + }c; + int x[10], y[10]; + + if (j == 2) + { + memcpy (x, y, 10 * sizeof (int)); + return sizeof (c); + } + else + return sizeof (c) * 3; +} + +int +main () +{ + typedef struct + { + int c[22]; + }c; + if (sub1 (20, 3) != sizeof (c)*3) + abort (); + + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/930529-1.x b/gcc/testsuite/gcc.c-torture/execute/930529-1.x index a44f482c22f..fb86979f7c1 100644 --- a/gcc/testsuite/gcc.c-torture/execute/930529-1.x +++ b/gcc/testsuite/gcc.c-torture/execute/930529-1.x @@ -4,15 +4,20 @@ # The problem is that the multiplication was unsigned SImode, and the # induction variable is DImode, and we lose the truncation that # should have happened. +# +# On tree-ssa branch, the loop problem is still extant, but the +# gimple-level optimization makes it easy for the tree-rtl expanders +# to see that the comparisons are always true, and so the loop code +# is never exercized. -set torture_eval_before_execute { - - set compiler_conditional_xfail_data { - "division by a constant conflicts with strength reduction" \ - "alpha*-*-*" \ - { "-O3" } \ - { "" } - } -} +# set torture_eval_before_execute { +# +# set compiler_conditional_xfail_data { +# "division by a constant conflicts with strength reduction" \ +# "alpha*-*-*" \ +# { "-O3" } \ +# { "" } +# } +# } return 0 diff --git a/gcc/testsuite/gcc.c-torture/execute/builtin-constant.x b/gcc/testsuite/gcc.c-torture/execute/builtin-constant.x deleted file mode 100644 index 7a2e3146675..00000000000 --- a/gcc/testsuite/gcc.c-torture/execute/builtin-constant.x +++ /dev/null @@ -1,11 +0,0 @@ -set torture_eval_before_execute { - global compiler_conditional_xfail_data - set compiler_conditional_xfail_data { - "This test fails on all targets when optimizing." \ - { "*-*-*" } \ - { "-O1" } \ - { "" } - } -} - -return 0 diff --git a/gcc/testsuite/gcc.dg/20010516-1.c b/gcc/testsuite/gcc.dg/20010516-1.c new file mode 100644 index 00000000000..e9b419f1a68 --- /dev/null +++ b/gcc/testsuite/gcc.dg/20010516-1.c @@ -0,0 +1,5 @@ +foo() +{ + char d; + __asm volatile ( "" :: "m"(&d)); /* { dg-error "" "non-lvalue" } */ +} diff --git a/gcc/testsuite/gcc.dg/20030612-1.c b/gcc/testsuite/gcc.dg/20030612-1.c index f9f212caba1..5ecc4c1da89 100644 --- a/gcc/testsuite/gcc.dg/20030612-1.c +++ b/gcc/testsuite/gcc.dg/20030612-1.c @@ -1,20 +1,22 @@ -/* Derived from PR middle-end/168. */ +/* { dg-do run } */ +/* { dg-options "-O2" } */ -/* { dg-do compile } */ -/* { dg-options "-W" } */ +int A, B; -extern void foo (); - -unsigned char uc; -unsigned short int usi; -unsigned int ui; - - -void bar() +void foo() { - if (uc + usi >= ui) /* { dg-bogus "between signed and unsigned" } */ - foo (); - if (uc * usi >= ui) /* { dg-bogus "between signed and unsigned" } */ - foo (); + long x = 3; + (void)({ + A = B + x + ((1) - 1); + return; /* { dg-warning "statement-expressions should end with a non-void expression" } */ + }); } +main() +{ + B = 5; + foo(); + if (A != 8) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/20030805-1.c b/gcc/testsuite/gcc.dg/20030805-1.c new file mode 100644 index 00000000000..6297c5d83ea --- /dev/null +++ b/gcc/testsuite/gcc.dg/20030805-1.c @@ -0,0 +1,23 @@ +/* Test that gcc understands that the call to g might clobber i. */ + +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +__inline int f () +{ + static int i; + int i2 = i; + i = i2 + 1; + return i; +} + +int g () { return f (); } + +int main () +{ + if (f() != 1 + || g() != 2 + || f() != 3) + return 1; + return 0; +} diff --git a/gcc/testsuite/gcc.dg/20040202-1.c b/gcc/testsuite/gcc.dg/20040202-1.c new file mode 100644 index 00000000000..f0f4e74109a --- /dev/null +++ b/gcc/testsuite/gcc.dg/20040202-1.c @@ -0,0 +1,8 @@ +/* PR middle-end/13325 */ +/* { dg-do compile } */ +/* { dg-options "-Wall" } */ + +void *memcpy(void *dest, const void *src, __SIZE_TYPE__ n); +void f (void *dest, const void *src) { + memcpy (dest, src, 0); +} diff --git a/gcc/testsuite/gcc.dg/20040206-1.c b/gcc/testsuite/gcc.dg/20040206-1.c new file mode 100644 index 00000000000..7fc4b0d7605 --- /dev/null +++ b/gcc/testsuite/gcc.dg/20040206-1.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -W -Wall" } */ +/* PR c/13127 + On the tree-ssa this used to warn about an anonymous + uninitialized variable. + + The warning about "no return statement in function + returning non-void" is PR 13000. */ + +static int foo (int a __attribute__((unused)) ) { } /* { dg-warning "return" "" { xfail *-*-* } } */ +int main (void) { return foo (0); } diff --git a/gcc/testsuite/gcc.dg/Wswitch-2.c b/gcc/testsuite/gcc.dg/Wswitch-2.c index b151e2310c7..9bc7d022b46 100644 --- a/gcc/testsuite/gcc.dg/Wswitch-2.c +++ b/gcc/testsuite/gcc.dg/Wswitch-2.c @@ -13,19 +13,19 @@ foo (enum e ei, int j) case e3: return 2; case e4: return 3; } /* No warning here since e2 has the same value as e3. */ - switch (ei) + switch (ei) /* { dg-warning "enumeration value `e4' not handled in switch" "enum e4" } */ { case e1: return 1; case e2: return 2; - } /* { dg-warning "enumeration value `e4' not handled in switch" "enum e4" } */ + } switch ((int) ei) { case e1: return 1; } /* No warning here since switch condition was cast to int. */ - switch ((enum e) j) + switch ((enum e) j) /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ { case e2: return 1; case e4: return 2; - } /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ + } return 0; } diff --git a/gcc/testsuite/gcc.dg/Wswitch-default.c b/gcc/testsuite/gcc.dg/Wswitch-default.c index a1a3d39c1d9..2d4e7994c25 100644 --- a/gcc/testsuite/gcc.dg/Wswitch-default.c +++ b/gcc/testsuite/gcc.dg/Wswitch-default.c @@ -7,11 +7,11 @@ int foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, enum e em, enum e en, enum e eo, enum e ep) { - switch (i) + switch (i) /* { dg-warning "switch missing default case" } */ { case 1: return 1; case 2: return 2; - } /* { dg-warning "switch missing default case" } */ + } switch (j) { case 3: return 4; @@ -25,32 +25,32 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, { default: break; } - switch (ek) + switch (ek) /* { dg-warning "switch missing default case" } */ { case e1: return 1; - } /* { dg-warning "switch missing default case" } */ + } switch (el) { case e1: return 1; default: break; } - switch (em) + switch (em) /* { dg-warning "switch missing default case" } */ { case e1: return 1; case e2: return 2; - } /* { dg-warning "switch missing default case" } */ + } switch (en) { case e1: return 1; case e2: return 2; default: break; } - switch (eo) + switch (eo) /* { dg-warning "switch missing default case" } */ { case e1: return 1; case e2: return 2; case 3: return 3; - } /* { dg-warning "switch missing default case" } */ + } switch (ep) { case e1: return 1; diff --git a/gcc/testsuite/gcc.dg/Wswitch-enum.c b/gcc/testsuite/gcc.dg/Wswitch-enum.c index d031b12ce14..b51ecfdcc9e 100644 --- a/gcc/testsuite/gcc.dg/Wswitch-enum.c +++ b/gcc/testsuite/gcc.dg/Wswitch-enum.c @@ -22,19 +22,19 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, switch (ei) /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ { /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" { target *-*-* } 22 } */ } - switch (ej) - { /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" { target *-*-* } 28 } */ + switch (ej) /* { dg-warning "enumeration value `e1' not handled in switch" "enum e1" } */ + { /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" { target *-*-* } 25 } */ default: break; - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ - switch (ek) + } + switch (ek) /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ { case e1: return 1; - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ - switch (el) + } + switch (el) /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ { case e1: return 1; default: break; - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ + } switch (em) { case e1: return 1; @@ -50,14 +50,14 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, { case e1: return 1; case e2: return 2; - case 3: return 3; - } /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + case 3: return 3; /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + } switch (ep) { case e1: return 1; case e2: return 2; - case 3: return 3; + case 3: return 3; /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ default: break; - } /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + } return 0; } diff --git a/gcc/testsuite/gcc.dg/Wswitch.c b/gcc/testsuite/gcc.dg/Wswitch.c index 38c3cbbb446..e3deeab0f4b 100644 --- a/gcc/testsuite/gcc.dg/Wswitch.c +++ b/gcc/testsuite/gcc.dg/Wswitch.c @@ -26,10 +26,10 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, { default: break; } - switch (ek) + switch (ek) /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ { case e1: return 1; - } /* { dg-warning "enumeration value `e2' not handled in switch" "enum e2" } */ + } switch (el) { case e1: return 1; @@ -50,8 +50,8 @@ foo (int i, int j, enum e ei, enum e ej, enum e ek, enum e el, { case e1: return 1; case e2: return 2; - case 3: return 3; - } /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + case 3: return 3; /* { dg-warning "case value `3' not in enumerated type `e'" "excess 3" } */ + } switch (ep) { case e1: return 1; diff --git a/gcc/testsuite/gcc.dg/asm-7.c b/gcc/testsuite/gcc.dg/asm-7.c index 42f40e719f9..a14bb807369 100644 --- a/gcc/testsuite/gcc.dg/asm-7.c +++ b/gcc/testsuite/gcc.dg/asm-7.c @@ -12,8 +12,8 @@ void test(void) __asm__ ("" : : "m"(r)); /* { dg-warning "address of register" } */ __asm__ ("" : : "m"(i)); __asm__ ("" : : "m"(m)); - __asm__ ("" : : "m"(0)); /* { dg-warning "input without lvalue" } */ - __asm__ ("" : : "m"(i+1)); /* { dg-warning "input without lvalue" } */ + __asm__ ("" : : "m"(0)); /* { dg-error "" } */ + __asm__ ("" : : "m"(i+1)); /* { dg-error "" } */ __asm__ ("" : : "m"(*p++)); __asm__ ("" : : "g"(r)); diff --git a/gcc/testsuite/gcc.dg/i386-ssetype-1.c b/gcc/testsuite/gcc.dg/i386-ssetype-1.c index 50d0fcaa58a..e4a099bb0b0 100644 --- a/gcc/testsuite/gcc.dg/i386-ssetype-1.c +++ b/gcc/testsuite/gcc.dg/i386-ssetype-1.c @@ -4,7 +4,8 @@ /* { dg-final { scan-assembler "andnpd\[^\\n\]*magic" } } */ /* { dg-final { scan-assembler "xorpd\[^\\n\]*magic" } } */ /* { dg-final { scan-assembler "orpd\[^\\n\]*magic" } } */ -/* { dg-final { scan-assembler-not "movdqa" } } */ +/* ??? All of the backend patters are WAY too fragile. */ +/* { dg-final { scan-assembler-not "movdqa" { xfail *-*-* } } } */ /* { dg-final { scan-assembler "movapd\[^\\n\]*magic" } } */ /* Verify that we generate proper instruction with memory operand. */ diff --git a/gcc/testsuite/gcc.dg/i386-ssetype-3.c b/gcc/testsuite/gcc.dg/i386-ssetype-3.c index 3b2461be32c..f19f5e8b928 100644 --- a/gcc/testsuite/gcc.dg/i386-ssetype-3.c +++ b/gcc/testsuite/gcc.dg/i386-ssetype-3.c @@ -4,7 +4,8 @@ /* { dg-final { scan-assembler "andnps\[^\\n\]*magic" } } */ /* { dg-final { scan-assembler "xorps\[^\\n\]*magic" } } */ /* { dg-final { scan-assembler "orps\[^\\n\]*magic" } } */ -/* { dg-final { scan-assembler-not "movdqa" } } */ +/* ??? All of the backend patters are WAY too fragile. */ +/* { dg-final { scan-assembler-not "movdqa" { xfail *-*-* } } } */ /* { dg-final { scan-assembler "movaps\[^\\n\]*magic" } } */ /* Verify that we generate proper instruction with memory operand. */ diff --git a/gcc/testsuite/gcc.dg/local1.c b/gcc/testsuite/gcc.dg/local1.c index 9d6fdb16752..e9f653bcc56 100644 --- a/gcc/testsuite/gcc.dg/local1.c +++ b/gcc/testsuite/gcc.dg/local1.c @@ -3,14 +3,14 @@ C90 6.1.2.2 [as corrected by TC1], C99 6.2.2: - For an identifier declared with the storage-class specifier - extern in a scope in which a prior declaration of that - identifier is visible, if the prior declaration specifies - internal or external linkage, the linkage of the identifier at - the later daclaration is the same as the linkage specified at - the prior declaration. If no prior declaration is visible, - or if the prior declaration specifies no linkage, then the - identifer has external linkage. + For an identifier declared with the storage-class specifier + extern in a scope in which a prior declaration of that + identifier is visible, if the prior declaration specifies + internal or external linkage, the linkage of the identifier at + the later daclaration is the same as the linkage specified at + the prior declaration. If no prior declaration is visible, + or if the prior declaration specifies no linkage, then the + identifer has external linkage. This is PR 14366. */ diff --git a/gcc/testsuite/gcc.dg/noncompile/920507-1.c b/gcc/testsuite/gcc.dg/noncompile/920507-1.c index 64ddce7f1ff..c1a3523008c 100644 --- a/gcc/testsuite/gcc.dg/noncompile/920507-1.c +++ b/gcc/testsuite/gcc.dg/noncompile/920507-1.c @@ -1,6 +1,7 @@ -void +int * x(void) { register int *a asm("unknown_register"); /* { dg-error "invalid register" } */ int *v[1] = {a}; + return v[1]; } diff --git a/gcc/testsuite/gcc.dg/noreturn-1.c b/gcc/testsuite/gcc.dg/noreturn-1.c index 3bf62c15b40..90660fa028c 100644 --- a/gcc/testsuite/gcc.dg/noreturn-1.c +++ b/gcc/testsuite/gcc.dg/noreturn-1.c @@ -7,8 +7,8 @@ extern void exit (int); extern void foo1(void) __attribute__ ((__noreturn__)); void foo1(void) -{ /* { dg-warning "`noreturn' function does return" "detect falling off end of noreturn" } */ -} +{ +} /* { dg-warning "`noreturn' function does return" "detect falling off end of noreturn" } */ extern void foo2(void) __attribute__ ((__noreturn__)); void @@ -26,16 +26,17 @@ foo3(void) extern void foo4(void); void foo4(void) -{ +{ /* { dg-warning "candidate for attribute `noreturn'" "detect noreturn candidate" } */ exit(0); -} /* { dg-warning "candidate for attribute `noreturn'" "detect noreturn candidate" } */ +} extern void foo5(void) __attribute__ ((__noreturn__)); void foo5(void) { return; /* { dg-warning "`noreturn' has a `return' statement" "detect invalid return" } */ -} /* { dg-warning "`noreturn' function does return" "detect return from noreturn" } */ +} +/* { dg-warning "function does return" "detect return from noreturn" { target *-*-* } 37 } */ extern void foo6(void); void diff --git a/gcc/testsuite/gcc.dg/noreturn-4.c b/gcc/testsuite/gcc.dg/noreturn-4.c index 4a2de5f4200..6a081b3fb4e 100644 --- a/gcc/testsuite/gcc.dg/noreturn-4.c +++ b/gcc/testsuite/gcc.dg/noreturn-4.c @@ -5,6 +5,6 @@ extern void exit (int) __attribute__ ((__noreturn__)); int main (void) -{ +{ /* { dg-warning "warning: function might be possible candidate for attribute `noreturn'" "warn for main" } */ exit (0); -} /* { dg-warning "warning: function might be possible candidate for attribute `noreturn'" "warn for main" } */ +} diff --git a/gcc/testsuite/gcc.dg/noreturn-7.c b/gcc/testsuite/gcc.dg/noreturn-7.c index 1d94a7ccea5..94a26cc3875 100644 --- a/gcc/testsuite/gcc.dg/noreturn-7.c +++ b/gcc/testsuite/gcc.dg/noreturn-7.c @@ -14,11 +14,11 @@ void _exit(int status) __attribute__ ((__noreturn__)); int z = 0; void g() -{ +{ /* { dg-warning "possible candidate" } */ if (++z > 10) _exit(0); g(); -} /* { dg-warning "possible candidate" } */ +} void f() { @@ -28,15 +28,15 @@ void f() } /* { dg-bogus "does return" } */ int h() -{ +{ /* { dg-warning "possible candidate" } */ if (++z > 10) _exit(0); return h(); } /* { dg-bogus "end of non-void function" } */ int k() -{ +{ /* { dg-warning "possible candidate" } */ if (++z > 10) _exit(0); k(); -} /* { dg-warning "end of non-void function" } */ +} diff --git a/gcc/testsuite/gcc.dg/pr14475.c b/gcc/testsuite/gcc.dg/pr14475.c new file mode 100644 index 00000000000..8009d465657 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr14475.c @@ -0,0 +1,8 @@ +/* This used to ICE because there was no null check in + check_bitfield_type_and_width. */ + +struct tree_common +{ + enum tree_code code : 8; /* {dg-error "" "" } */ +/* { dg-warning "" "" { target *-*-* } 6 } */ +}; diff --git a/gcc/testsuite/gcc.dg/return-type-1.c b/gcc/testsuite/gcc.dg/return-type-1.c index 037dbbf0823..2507cafa5e4 100644 --- a/gcc/testsuite/gcc.dg/return-type-1.c +++ b/gcc/testsuite/gcc.dg/return-type-1.c @@ -5,5 +5,5 @@ /* { dg-options "-O -Wreturn-type" } */ int foo(void) -{ /* { dg-warning "control reaches end of non-void function" "warning for falling off end of non-void function" } */ -} +{ +} /* { dg-warning "control reaches end of non-void function" "warning for falling off end of non-void function" } */ diff --git a/gcc/testsuite/gcc.dg/return-type-3.c b/gcc/testsuite/gcc.dg/return-type-3.c index b6fa16539a4..e06ba7c0233 100644 --- a/gcc/testsuite/gcc.dg/return-type-3.c +++ b/gcc/testsuite/gcc.dg/return-type-3.c @@ -3,7 +3,7 @@ call optimization. The return clobber insn was cleaned up and the warning was never issued. */ /* { dg-do compile } */ -/* { dg-options "-foptimize-sibling-calls -Wreturn-type" } */ +/* { dg-options "-O -foptimize-sibling-calls -Wreturn-type" } */ extern void foo(void); diff --git a/gcc/testsuite/gcc.dg/tls/asm-1.c b/gcc/testsuite/gcc.dg/tls/asm-1.c index 68c49f61180..476fe7cbb72 100644 --- a/gcc/testsuite/gcc.dg/tls/asm-1.c +++ b/gcc/testsuite/gcc.dg/tls/asm-1.c @@ -3,5 +3,5 @@ __thread int i; int foo () { - asm volatile ("" :: "m" (&i)); /* { dg-error "lvalue" } */ + asm volatile ("" :: "m" (&i)); /* { dg-error "directly addressable" } */ } diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030530-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030530-2.c new file mode 100644 index 00000000000..408e2464e96 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030530-2.c @@ -0,0 +1,26 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +typedef struct rs6000_stack { + int first_gp_reg_save; +} rs6000_stack_t; +extern char regs_ever_live[113]; +extern rs6000_stack_t *rs6000_stack_info (void); +void +rs6000_emit_prologue (int i, rs6000_stack_t *info) +{ + if (regs_ever_live[info->first_gp_reg_save + i] || i+info->first_gp_reg_save) + gen_rtx_REG (info->first_gp_reg_save + i); +} + +/* There should be precisely one load of first_gp_reg_save. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "first_gp_reg_save" 1 "dom3"} } */ + +/* There should be precisely one addition. If there is more than one, then + the dominator optimizations failed, most likely due to not handling + commutative operands correctly. */ +/* { dg-final { scan-tree-dump-times "\\+" 1 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030611-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030611-1.c new file mode 100644 index 00000000000..d16bda4c1f1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030611-1.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +extern int square (int) __attribute__ ((__const__)); +shit(int a) +{ + return square (a) + square (a); + +} + +/* There should be precisely one call to square. If there is more than one, + then the dominator optimizations failed to remove the redundant call. */ +/* { dg-final { scan-tree-dump-times "square" 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030703-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030703-1.c new file mode 100644 index 00000000000..f5b3db3460d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030703-1.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +extern int blah[]; + +foo(int index) +{ + if (blah [(unsigned int)index] != 0) + abort (); + if (blah [(unsigned int)index] != 0) + abort (); +} + +/* There should be precisely one load of blah. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "blah" 1 "dom3"} } */ + +/* There should be exactly one IF conditional. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030703-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030703-2.c new file mode 100644 index 00000000000..a73150a06a3 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030703-2.c @@ -0,0 +1,41 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +union tree_node; +typedef union tree_node *tree; +extern const char tree_code_type[]; + +union tree_node +{ + int code; + long pointer_alias_set; +}; + +long +get_alias_set (t) + tree t; +{ + if (tree_code_type[t->code]) + abort (); + if (t->pointer_alias_set) + { + tree __t = t; + if (tree_code_type[__t->code]) + abort (); + } +} + +/* There should be precisely one load of {t,__t}->code. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "->code" 1 "dom3"} } */ + +/* There should be precisely one load of tree_code_type. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "tree_code_type" 1 "dom3"} } */ + +/* There should be one IF conditional. If 'tree_code_type[t->code]' is + zero, then the third if() conditional is unnecessary. That should cause + the call to abort() to be removed, which in turn causes the whole second + if() to disappear. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030708-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030708-1.c new file mode 100644 index 00000000000..a94f2a7c6c9 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030708-1.c @@ -0,0 +1,41 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ +struct rtx_def; +typedef struct rtx_def *rtx; +enum rtx_code +{ + CALL_INSN, + EXPR_LIST, + NOTE +}; + +struct rtx_def +{ + + enum rtx_code code:16; +}; + +static int +nonlocal_mentioned_p (x) + rtx x; +{ + if (x->code == CALL_INSN) + { + rtx const _rtx = ((x)); + if (_rtx->code != CALL_INSN + && _rtx->code != NOTE + && _rtx->code != EXPR_LIST) + abort (); + } + + blah (&x); +} + +/* There should be no casts to a short unsigned int since the entire + set of conditionals should optimize away. */ +/* { dg-final { scan-tree-dump-times "\\(short unsigned int\\)" 0 "dom3"} } */ + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030709-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030709-1.c new file mode 100644 index 00000000000..dc45cbd73a2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030709-1.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +static int copying_arguments; +static int +foo () +{ + unsigned int regno; + if (regno < 53 && copying_arguments) + if (regno >= 53) + return 1; +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030709-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030709-2.c new file mode 100644 index 00000000000..ffa7f477622 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030709-2.c @@ -0,0 +1,53 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; +union tree_node; +typedef union tree_node *tree; +typedef struct mem_attrs +{ + int foo; + +} mem_attrs; +union rtunion_def +{ + mem_attrs *rtmem; +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + rtunion fld[1]; +}; +struct tree_decl +{ + rtx rtl; +}; +union tree_node +{ + struct tree_decl decl; +}; +void * +get_alias_set (t) + tree t; +{ + long set; + if (t->decl.rtl) + return (t->decl.rtl->fld[1].rtmem + ? 0 + : (((t->decl.rtl ? t->decl.rtl: (make_decl_rtl (t, 0), t->decl.rtl)))->fld[1]).rtmem); + return (void*)-1; +} + +/* There should be precisely one load of ->decl.rtl. If there is + more than, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "->decl\\.rtl" 1 "cddce"} } */ + +/* There should be no loads of .rtmem since the complex return statement + is just "return 0". */ +/* { dg-final { scan-tree-dump-times ".rtmem" 0 "cddce"} } */ + +/* There should be one IF statement (the complex return statement should + collapse down to a simple return 0 without any conditionals). */ +/* { dg-final { scan-tree-dump-times "if " 1 "cddce"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030709-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20030709-3.c new file mode 100644 index 00000000000..98681c088c9 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030709-3.c @@ -0,0 +1,45 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +union tree_node; +typedef union tree_node *tree; +enum tree_code +{ + TREE_VEC = 20, +}; +struct tree_common +{ + int code; +}; +struct tree_type +{ + tree binfo; +}; +union tree_node +{ + struct tree_common common; + struct tree_type type; +}; +void +record_component_aliases (type) + tree type; +{ + const tree __z = type->type.binfo; + if (type->type.binfo->common.code != TREE_VEC) + abort (); + + if (__z->common.code != TREE_VEC) + abort (); +} + +/* There should be precisely one load of type.binfo. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "type\\.binfo" 1 "dom3"} } */ + +/* There should be precisely one load of common.code. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "common\\.code" 1 "dom3"} } */ + +/* There should be one IF conditional. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030710-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030710-1.c new file mode 100644 index 00000000000..53e3d5992cf --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030710-1.c @@ -0,0 +1,53 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +union tree_node; +typedef union tree_node *tree; +struct tree_vec +{ + int length; + tree a[1]; +}; +struct tree_type +{ + tree binfo; +}; +union tree_node +{ + struct tree_type type; + struct tree_vec vec; +}; +void +record_component_aliases (type) + tree type; +{ + if (type->type.binfo->vec.length) + abort (); + for (; (( + { + const tree __z = type->type.binfo; + if (type->type.binfo->vec.length) + abort (); + type->type.binfo->vec.a[4];} + )->vec.length);) + { + if (4 >= type->type.binfo->vec.length) + abort (); + blah (); + } +} + +/* The call to blah should have been eliminated. If the call is not + eliminated, then dominator optimizations failed and it'll be + impossible to delete other unnecessary code. */ +/* { dg-final { scan-tree-dump-not "blah \\(\\)" "dom3" } } */ + +/* There should be two IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 2 "dom3"} } */ + +/* There should be a single load of type.binfo. */ +/* { dg-final { scan-tree-dump-times "type\\.binfo" 1 "dom3"} } */ + +/* There should be two loads of vec.length. */ +/* { dg-final { scan-tree-dump-times "vec.length" 2 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030711-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030711-1.c new file mode 100644 index 00000000000..eba207a25e5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030711-1.c @@ -0,0 +1,53 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +union tree_node; +typedef union tree_node *tree; +struct tree_vec +{ + int length; + tree a[1]; +}; +struct tree_type +{ + tree binfo; +}; +union tree_node +{ + struct tree_type type; + struct tree_vec vec; +}; + +void +record_component_aliases (type) + tree type; +{ + int i; + if (4 >= type->type.binfo->vec.length) + abort (); + for (; i < (( + { + const tree __t = type->type.binfo; + if (4 >= __t->vec.length) + abort (); type->type.binfo->vec.a[4];} + )->vec.length);) + { + if (4 >= type->type.binfo->vec.length) + abort (); + blah (); + } +} + +/* The call to blah can not be eliminated. */ +/* { dg-final { scan-tree-dump-times "blah \\(\\)" 1 "dom3" } } */ + +/* There should be four IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 4 "dom3"} } */ + +/* There should be two loads of type.binfo. */ +/* { dg-final { scan-tree-dump-times "type\\.binfo" 2 "dom3"} } */ + +/* There should be four loads of vec.length. */ +/* { dg-final { scan-tree-dump-times "vec.length" 4 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030711-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030711-2.c new file mode 100644 index 00000000000..2fd47f753cf --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030711-2.c @@ -0,0 +1,67 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtvec_def; +typedef struct rtvec_def *rtvec; +union tree_node; +typedef union tree_node *tree; +typedef struct mem_attrs +{ + long alias; +} +mem_attrs; +union rtunion_def +{ + mem_attrs *rtmem; +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + int code; + rtunion fld[1]; +}; +struct tree_decl +{ + rtx rtl; +}; +union tree_node +{ + struct tree_decl decl; +}; +long +get_alias_set (t,z) + tree t; + rtx z; +{ + if (t->decl.rtl && (((t->decl.rtl ? z + : (make_decl_rtl (t, 0), t->decl.rtl)))->code)) + return (((((t->decl.rtl ? z : (make_decl_rtl (t, 0), t->decl.rtl)))-> + fld[1]).rtmem) == 0 ? 0 : ((((( + { + t;} + )->decl. + rtl ? z : (make_decl_rtl (t, 0), + t->decl.rtl)))-> + fld[1]).rtmem)->alias); +} + +/* The calls to make_decl_rtl should be eliminated +/* { dg-final { scan-tree-dump-not "make_decl_rtl \\(\\)" "dom3" } } */ + +/* There should be three IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 3 "dom3"} } */ + +/* There should be one loads of decl.rtl. */ +/* { dg-final { scan-tree-dump-times "decl\\.rtl" 1 "dom3"} } */ + +/* There should be one load of code. */ +/* { dg-final { scan-tree-dump-times "code" 1 "dom3"} } */ + +/* There should be one load of rtmem. */ +/* { dg-final { scan-tree-dump-times "rtmem" 1 "dom3"} } */ + +/* There should be one load of alias. */ +/* { dg-final { scan-tree-dump-times "->alias" 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030711-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20030711-3.c new file mode 100644 index 00000000000..515f3609f70 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030711-3.c @@ -0,0 +1,59 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtvec_def; +typedef struct rtvec_def *rtvec; +union tree_node; +typedef union tree_node *tree; +typedef struct mem_attrs +{ + long alias; +} +mem_attrs; +union rtunion_def +{ + mem_attrs *rtmem; +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + int code; + rtunion fld[1]; +}; +struct tree_decl +{ + rtx rtl; +}; +union tree_node +{ + struct tree_decl decl; +}; +long +get_alias_set (t) + tree t; +{ + if (t->decl.rtl != (void *) 0) + return (((t->decl.rtl->fld[1]).rtmem) == + 0 ? 0 + : ((((t->decl. + rtl ? 0 : (make_decl_rtl (t, ((void *) 0)), + t->decl.rtl)))->fld[1]).rtmem)->alias); +} + +/* The calls to make_decl_rtl should be eliminated. */ +/* { dg-final { scan-tree-dump-not "make_decl_rtl \\(\\)" "dom3" } } */ + +/* There should be two IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 2 "dom3"} } */ + +/* There should be one load of decl.rtl. */ +/* { dg-final { scan-tree-dump-times "decl\\.rtl" 1 "dom3"} } */ + +/* There should be two loads of rtmem. */ +/* { dg-final { scan-tree-dump-times "rtmem" 2 "dom3"} } */ + +/* There should be one load of alias. */ +/* { dg-final { scan-tree-dump-times "->alias" 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030714-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030714-1.c new file mode 100644 index 00000000000..936df5371c4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030714-1.c @@ -0,0 +1,44 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; +enum rtx_code +{ + REG, + LAST_AND_UNUSED_RTX_CODE +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + enum rtx_code code:16; + unsigned frame_related:1; +}; +static rtx +find_base_value (src) + rtx src; +{ + rtx temp; + rtx src_0; + rtx src_1; + + if ((src_0->code == REG) && (({src_0;})->frame_related)) + return find_base_value (src_0); + if ((src_1->code == REG) && (({ src_1;})->frame_related)) + return find_base_value (src_1); + if (src_0->code == REG) + find_base_value (src_0); + if (src_1->code == REG) + find_base_value (src_1); +} + + +/* There should be six IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 6 "dom3"} } */ + +/* There should be no casts to short unsigned int. */ +/* { dg-final { scan-tree-dump-times "\\(short unsigned int\\)" 0 "dom3"} } */ + +/* There should be three loads of ->code. */ +/* { dg-final { scan-tree-dump-times "->code" 3 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030714-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030714-2.c new file mode 100644 index 00000000000..6a43360b07f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030714-2.c @@ -0,0 +1,39 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +union tree_node; +typedef union tree_node *tree; +extern const char tree_code_type[]; +struct tree_common +{ + int code; + tree type; +}; +struct tree_exp +{ + tree operands[1]; +}; +union tree_node +{ + struct tree_common common; + struct tree_exp exp; +}; +long +get_alias_set (t) + tree t; +{ + if (tree_code_type[t->common.code] != 't' && t->common.type == 0) + return 0; + if (tree_code_type[t->common.code] != 't') + { + while (t->exp.operands[0]) + t = t->exp.operands[0]; + } +} + +/* There should be exactly four IF conditionals if we thread jumps + properly. */ +/* { dg-final { scan-tree-dump-times "if " 4 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030728-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030728-1.c new file mode 100644 index 00000000000..4bc04bc4da4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030728-1.c @@ -0,0 +1,47 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + + +union tree_node; +typedef union tree_node *tree; + +enum tree_code +{ + ARRAY_TYPE, + LAST_AND_UNUSED_TREE_CODE +}; + +struct tree_common +{ + enum tree_code code:8; +}; + + + + + +union tree_node +{ + struct tree_common common; +}; + + + + +int +objects_must_conflict_p (t1, t2) + tree t1, t2; +{ + + if ((t1->common.code == ARRAY_TYPE) != (t2 + && t2->common.code == ARRAY_TYPE)) + return 0; + + + return foo (t2 ? get_alias_set (t2) : 0); +} + +/* There should be three assignments of variables to the value zero. */ +/* { dg-final { scan-tree-dump-times " = 0" 3 "optimized"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030729-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030729-1.c new file mode 100644 index 00000000000..b4b1a819ff4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030729-1.c @@ -0,0 +1,51 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +union tree_node; +typedef union tree_node *tree; + + +enum tree_code +{ + SET_TYPE, + RECORD_TYPE, + LAST_AND_UNUSED_TREE_CODE +}; +extern const char tree_code_type[]; + +struct tree_common +{ + + enum tree_code code:8; +}; + + + + + +union tree_node +{ + struct tree_common common; +}; + +readonly_fields_p (type) + tree type; +{ + + if (type->common.code != RECORD_TYPE) + return; + + if (tree_code_type[type->common.code] != 't') + abort (); + + return; +} + +/* A good optimizer would realize that the cast to (unsigned int) is + useless as the earlier cast of the same value of (unsigned char) will + always produce the same result. */ +/* { dg-final { scan-tree-dump-times "\\(unsigned int\\)" 0 "dom3"} } */ + +/* There should be one load of ->common.code. We currently fail this + because we load from ->common.code using different types. */ +/* { dg-final { scan-tree-dump-times "common\.code" 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030730-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030730-1.c new file mode 100644 index 00000000000..643b5e79271 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030730-1.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom3" } */ + +extern void *ggc_alloc (__SIZE_TYPE__); +typedef struct dw_attr_struct *dw_attr_ref; +typedef struct dw_attr_struct +{ + int dw_attr; +} +dw_attr_node; +void +foo (int attr_kind, unsigned long offset) +{ + dw_attr_ref attr = (dw_attr_ref) ggc_alloc (sizeof (dw_attr_node)); + attr->dw_attr = attr_kind; + if (attr != 0) + exit (0); +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030730-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030730-2.c new file mode 100644 index 00000000000..06b5710f65f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030730-2.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom3" } */ + +extern void *ggc_alloc (__SIZE_TYPE__); +typedef struct dw_attr_struct *dw_attr_ref; +typedef struct dw_attr_struct +{ + int dw_attr; +} +dw_attr_node; +void +foo (int attr_kind, unsigned long offset) +{ + dw_attr_ref attr = (dw_attr_ref) ggc_alloc (sizeof (dw_attr_node)); + attr->dw_attr = attr_kind; + if (attr != ((void *)0)) + exit (0); +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030731-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030731-1.c new file mode 100644 index 00000000000..82634da1c5b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030731-1.c @@ -0,0 +1,65 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtvec_def; +typedef struct rtvec_def *rtvec; +union tree_node; +typedef union tree_node *tree; +struct rtx_def +{ + int code; + int mode; + unsigned int in_struct:1; +}; +struct tree_common +{ + int code; +}; +struct tree_decl +{ + rtx rtl; +}; +union tree_node +{ + struct tree_common common; + struct tree_decl decl; +}; +rtx +store_expr (exp, target, want_value) + tree exp; + rtx target; + int want_value; +{ + if (exp->common.code == 42) + abort (); + else if (queued_subexp_p (target)) + { + blah (target->mode); + if (target->code) + abort (); + } + else + { + if (target->code && (__extension__({target;})->in_struct)); + } + + if ((target != (exp->decl.rtl + ? (exp->decl.rtl + ? exp->decl.rtl + : (make_decl_rtl (exp, 0), exp->decl.rtl)) + : 0)) + && expr_size (exp)) + ; +} + +/* All paths to the test "target != 0" occuring in the final IF statement + dereference target. Thus target can not have the value zero at that + point and the test should have been eliminated. */ +/* ??? The dominator walker (A) doesn't merge this data at joins and + (B) only looks at immediate dominators, and only queued_subexp_p + immediately dominates the comparison in question. We need something + stronger. */ +/* { dg-final { scan-tree-dump-times "target.*!= 0" 0 "dom3" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030731-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030731-2.c new file mode 100644 index 00000000000..b088f007447 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030731-2.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + + +bar (int i, int partial, int args_addr) +{ + int offset = 0; + if (args_addr == 0) + offset = 0; + if (i >= offset) + foo (); +} + +/* There should be only one IF conditional since the first does nothing + useful. */ +/* { dg-final { scan-tree-dump-times "if " 1 "ccp"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-1.c new file mode 100644 index 00000000000..ab013d3d9fc --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-1.c @@ -0,0 +1,46 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; + + + +union rtunion_def +{ + int rtint; +}; +typedef union rtunion_def rtunion; + + + +struct rtx_def +{ + rtunion fld[1]; + +}; + +static int *uid_cuid; +static int max_uid_cuid; + +static rtx +bar (rtx r) +{ + rtx place = r; + + if (place->fld[0].rtint <= max_uid_cuid + && (place->fld[0].rtint > max_uid_cuid ? insn_cuid (place) : + uid_cuid[place->fld[0].rtint])) + return r; + + return 0; +} + +/* There should be two IF conditionals. One tests <= max_uid_cuid, the + other tets the value in uid_cuid. If either is false the jumps + are threaded to the return 0. Which in turn means the path + which combines the result of those two tests into a new test + must always be true and it is optimized appropriately. */ +/* { dg-final { scan-tree-dump-times "if " 2 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-10.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-10.c new file mode 100644 index 00000000000..709395511a4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-10.c @@ -0,0 +1,25 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +extern const unsigned char mode_size[]; +unsigned int +subreg_highpart_offset (outermode, innermode) + int outermode, innermode; +{ + unsigned int offset = 0; + int difference = (mode_size[innermode] - mode_size[outermode]); + if (difference > 0) + { + offset += difference % (0 ? 8 : 4); + offset += difference / 4 * 4; + } + return offset; +} + +/* There should be one mask with the value 3. */ +/* { dg-final { scan-tree-dump-times " \& 3" 1 "dom3"} } */ + +/* There should be one right shift by 2 places. */ +/* { dg-final { scan-tree-dump-times " >> 2" 1 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-11.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-11.c new file mode 100644 index 00000000000..6296346095d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-11.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtx_def +{ + int code; +}; +foo (reg) + rtx reg; +{ + reg->code = 42; + if (reg->code != 42) + abort (); +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-2.c new file mode 100644 index 00000000000..e9837d38814 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-2.c @@ -0,0 +1,26 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +oof () +{ + int live_head; + int * live = &live_head; + + if (live) + bitmap_clear (live); +} + +foo(int n) +{ + int *space = (int *)__builtin_alloca (n); + + if (space == 0) + abort (); + else + bar (space); +} + + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-3.c new file mode 100644 index 00000000000..7e10d382c4e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-3.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +typedef unsigned int cppchar_t; +cppchar_t +cpp_parse_escape (pstr, limit, wide) + const unsigned char **pstr; + const unsigned char *limit; + int wide; +{ + cppchar_t i = 0; + int overflow = 0; + cppchar_t mask = ~0; + + while (*pstr < limit) + { + overflow |= i ^ (i << 4 >> 4); + i = oof (); + } + if (overflow | (i != (i & mask))) + foo(); +} + +/* There should be precisely three IF statements. If there is + more than two, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "if " 3 "dom3"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-5.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-5.c new file mode 100644 index 00000000000..b530c841a7f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-5.c @@ -0,0 +1,36 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; + + +struct rtx_def +{ + + int code; + unsigned int unchanging:1; + +}; +static rtx current_sym_addr; + +static int +foo () +{ + if (current_sym_addr->code == 42 + && (({ + rtx _rtx = current_sym_addr; + if (((_rtx)->code) != 42) + abort (); + _rtx;} + )->unchanging)) + return 0; +} + +/* There should be precisely one load of ->code. If there is + more than, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "->code" 1 "dom3"} } */ + +/* There should be two IF statements. One for 'current_sym_addr->code == 42'. + The other one for '(EXPR)->unchanging'. */ +/* { dg-final { scan-tree-dump-times "if " 2 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-6.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-6.c new file mode 100644 index 00000000000..3b24bcaf662 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-6.c @@ -0,0 +1,44 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +static void +foo (distance, i, j) + int distance[13][13]; + int i, j; +{ + if (distance[i][j] < 0) + distance[i][0] = ((distance[i][j]) < 0 ? -(distance[i][j]) : (distance[i][j])); +} + +static void +foo2 (distance, i, j) + int distance[13][13]; + int i, j; +{ + if (distance[i][j] <= 0) + distance[i][0] = ((distance[i][j]) < 0 ? -(distance[i][j]) : (distance[i][j])); +} + +static void +foo3 (distance, i, j) + int distance[13][13]; + int i, j; +{ + if (distance[i][j] > 0) + distance[i][0] = ((distance[i][j]) < 0 ? -(distance[i][j]) : (distance[i][j])); +} + +static void +foo4 (distance, i, j) + double distance[13][13]; + int i, j; +{ + if (distance[i][j] >= 0) + distance[i][0] = ((distance[i][j]) < 0 ? -(distance[i][j]) : (distance[i][j])); +} + +/* There should be no ABS_EXPR. */ +/* { dg-final { scan-tree-dump-times "ABS_EXPR " 0 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-7.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-7.c new file mode 100644 index 00000000000..7f31578307a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-7.c @@ -0,0 +1,37 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom3" } */ + + + +union tree_node; +typedef union tree_node *tree; +struct tree_common +{ + int code; +}; +struct tree_list +{ + tree purpose; +}; +union tree_node +{ + struct tree_common common; + struct tree_list list; +}; +void +simplify_condition (cond_p) + tree *cond_p; +{ + tree decl; + tree cond = *cond_p; + if (cond->common.code != 42) + abort (); + decl = cond->list.purpose; + if (cond->common.code != 42) + abort (); + c_simplify_stmt (&decl); +} + +/* There should be exactly one IF conditional. TBAA is not able to + determine that 'decl' and 'cond' can't alias. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-8.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-8.c new file mode 100644 index 00000000000..1241f32a7f8 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-8.c @@ -0,0 +1,52 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct die_struct; +typedef struct die_struct *dw_die_ref; +typedef struct dw_loc_list_struct *dw_loc_list_ref; +enum dw_val_class +{ + dw_val_class_loc_list, +}; +typedef struct dw_val_struct +{ + enum dw_val_class val_class; + union dw_val_struct_union + { + dw_loc_list_ref val_loc_list; + } + v; +} +dw_val_node; +typedef struct dw_attr_struct *dw_attr_ref; +typedef struct dw_attr_struct +{ + dw_val_node dw_attr_val; +} +dw_attr_node; + +extern __inline__ enum dw_val_class +AT_class (a) + dw_attr_ref a; +{ + return a->dw_attr_val.val_class; +} +extern __inline__ dw_loc_list_ref +AT_loc_list (a) + dw_attr_ref a; +{ + if (AT_class (a) == dw_val_class_loc_list) + return a->dw_attr_val.v.val_loc_list; +} +static void +output_location_lists (die) + dw_die_ref die; +{ + dw_die_ref c; + dw_attr_ref d_attr; + if (AT_class (d_attr) == dw_val_class_loc_list) + output_loc_list (AT_loc_list (d_attr)); +} + +/* There should be exactly one IF conditional, in output_location_lists. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030807-9.c b/gcc/testsuite/gcc.dg/tree-ssa/20030807-9.c new file mode 100644 index 00000000000..6144bd187ed --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030807-9.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +static void +bar () +{ + const char *label2 = (*"*.L_sfnames_b" == '*') + "*.L_sfnames_b"; + oof (label2); +} + +void +ooof () +{ + if (""[0] == 0) + foo(); +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030808-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030808-1.c new file mode 100644 index 00000000000..9a20a3040c5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030808-1.c @@ -0,0 +1,39 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-cddce" } */ + + +struct rtx_def; +typedef struct rtx_def *rtx; +enum rtx_code +{ + UNKNOWN, + CODE_LABEL, + NOTE, + LAST_AND_UNUSED_RTX_CODE +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + enum rtx_code code:16; +}; +void +delete_dead_jumptables () +{ + rtx insn, next; + if (insn->code == CODE_LABEL) + { + rtx const _rtx = insn; + if (_rtx->code != CODE_LABEL && _rtx->code != NOTE) + abort (); + } + ; +} + +/* There should be no loads of ->code. If any exist, then we failed to + optimize away all the IF statements and the statements feeding + their conditions. */ +/* { dg-final { scan-tree-dump-times "->code" 0 "cddce"} } */ + +/* There should be no IF statements. */ +/* { dg-final { scan-tree-dump-times "if " 0 "cddce"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-1.c new file mode 100644 index 00000000000..d165b19bfda --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-1.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +com(int *blah) +{ + int z = *blah; + if (z == 256) + { + oof (z); + abort (); + } + return *blah; +} + +/* There should be precisely one load of blah. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "\\*blah" 1 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-2.c new file mode 100644 index 00000000000..a3f2ae6b70b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-2.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +void +foo (int value) +{ + switch (value) + { + case 42: + if (value != 42) + abort (); + case 50: + blah (); + } +} + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-3.c new file mode 100644 index 00000000000..2058c0c987a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-3.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +void +foo (int value) +{ + switch (value) + { + case 40: + case 42: + if (value != 42) + abort (); + case 50: + blah (); + } +} + +/* There should be one IF conditional. */ +/* { dg-final { scan-tree-dump-times "if " 1 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-4.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-4.c new file mode 100644 index 00000000000..81711dd75cd --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-4.c @@ -0,0 +1,40 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3 -fdump-tree-optimized" } */ + +union tree_node; +typedef union tree_node *tree; +extern const char tree_code_type[]; +struct tree_common +{ + int code; +}; +struct tree_decl +{ + long pointer_alias_set; +}; +union tree_node +{ + struct tree_common common; + struct tree_decl decl; +}; +long +blah (decl, set) + tree decl; + long set; +{ + decl->decl.pointer_alias_set = set; + if (tree_code_type[decl->common.code] != 'd') + abort (); + record_alias_subset (decl->decl.pointer_alias_set); + if (set != -1) + set = 0; + return set; +} + +/* There should be precisely one reference to pointer_alias_set. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "pointer_alias_set" 1 "dom3"} } */ + +/* The assignment set = -1 in the ELSE clause of the last IF + statement should be removed by the final cleanup phase. */ +/* { dg-final { scan-tree-dump-times "set = -1" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-5.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-5.c new file mode 100644 index 00000000000..bab21a3cae8 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-5.c @@ -0,0 +1,40 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3 -fdump-tree-optimized" } */ + +union tree_node; +typedef union tree_node *tree; +extern const char tree_code_type[]; +struct tree_common +{ + int code; +}; +struct tree_decl +{ + long pointer_alias_set; +}; +union tree_node +{ + struct tree_common common; + struct tree_decl decl; +}; +long +blah (decl, set) + tree decl; + long set; +{ + decl->decl.pointer_alias_set = oof(); + if (tree_code_type[decl->common.code] != 'd') + abort (); + record_alias_subset (decl->decl.pointer_alias_set); + if (set != -1) + set = 0; + return set; +} + +/* There should be precisely one reference to pointer_alias_set. If there is + more than one, then the dominator optimizations failed. */ +/* { dg-final { scan-tree-dump-times "pointer_alias_set" 1 "dom3"} } */ + +/* The assignment set = -1 in the ELSE clause of the last IF + statement should be removed by the final cleanup phase. */ +/* { dg-final { scan-tree-dump-times "set = -1" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-6.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-6.c new file mode 100644 index 00000000000..c16fda9155c --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-6.c @@ -0,0 +1,43 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +union tree_node; +typedef union tree_node *tree; +enum tree_code +{ + LAST_AND_UNUSED_TREE_CODE +}; +extern const char tree_code_type[]; +struct tree_common +{ + enum tree_code code:8; +}; +struct tree_type +{ + double alias_set; +}; +union tree_node +{ + struct tree_common common; + struct tree_type type; +}; +long +foo (t, set) + tree t; + double set; +{ + if (tree_code_type[t->common.code] != 't') + abort (); + + t->type.alias_set = set; + + if (t->common.code == 42) + return 1; + else + return 0; +} +/* There should be precisely one load of common.code. If there is + more than one, then the dominator optimizations failed. */ +/* ??? Will fail until we properly distinguish member stores. At + present the write to type.alias_set kills the previous load. */ +/* { dg-final { scan-tree-dump-times "common.code" 1 "dom3" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030814-7.c b/gcc/testsuite/gcc.dg/tree-ssa/20030814-7.c new file mode 100644 index 00000000000..cbefbb33c1a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030814-7.c @@ -0,0 +1,40 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtvec_def; +typedef struct rtvec_def *rtvec; +union tree_node; +typedef union tree_node *tree; +struct tree_common +{ + int code; +}; +union tree_node +{ + struct tree_common common; +}; +extern tree current_function_decl; +struct cgraph_rtl_info +{ + _Bool pure_function; +}; +struct cgraph_rtl_info *cgraph_rtl_info (tree); +void +mark_constant_function (void) +{ + rtx insn; + int nonlocal_memory_referenced; + + if (current_function_decl->common.code != 42) + abort (); + + cgraph_rtl_info (current_function_decl)->pure_function = 1; +} + +/* current_function_decl should be loaded once into a temporary + and the temporary used as the argument to cgraph_rtl_info. + This if we find current_function_decl used as an argument, then + we have failed. */ +/* { dg-final { scan-tree-dump-times "\\(current_function_decl\\)" 0 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030815-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030815-1.c new file mode 100644 index 00000000000..13a4917e912 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030815-1.c @@ -0,0 +1,42 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + +typedef unsigned int size_t; +struct rtx_def; +typedef struct rtx_def *rtx; +typedef union varray_data_tag +{ + struct reg_info_def *reg[1]; +} varray_data; +struct varray_head_tag +{ + size_t num_elements; + varray_data data; +}; +typedef struct varray_head_tag *varray_type; +typedef struct reg_info_def +{ +} reg_info; +extern varray_type reg_n_info; +static rtx *reg_base_value; +static rtx *new_reg_base_value; +static rtx +blah (unsigned int regno) +{ + if (new_reg_base_value[regno] && ((*( + { + if (regno >= + reg_n_info-> + num_elements) + abort (); + ®_n_info->data.reg[regno];} + )))) + return reg_base_value[regno]; +} + +/* If we have more than 1 cast to a struct rtx_def * *, then we failed to + eliminate some useless typecasting. The first type cast is needed + to convert the unsigned int regno parameter into a struct rtx_def **. */ +/* { dg-final { scan-tree-dump-times "\\(struct rtx_def \\* \\*\\)" 1 "dom3"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030820-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030820-1.c new file mode 100644 index 00000000000..4b659ca3411 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030820-1.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-O1" } */ + +/* A test for unreachable blocks removal -- bind_expr whose entry is + unreachable, but it contains reachable statements. */ + +void foo(void) +{ + if (1) + { + goto bla; + } + else + { +xxx: + { +bla: + bar (); + return; + } + goto xxx; + } +} + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030820-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030820-2.c new file mode 100644 index 00000000000..9ca9fbb59c6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030820-2.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-O1" } */ + +/* A test for variables getting out of their scope in copy propagation. */ + +void foo(void) +{ + int k; + + goto forward; +back: + bla (k); + return; + +forward: + { + int i = bar (); + + k = i; + + goto back; + } +} + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030821-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030821-1.c new file mode 100644 index 00000000000..2d1e9e78df2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030821-1.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +void foo(int k) +{ + int i = 1; + void *label; + + label = k ? &&x : &&y; + + if (k == 1) + goto *label; + + i = 0; + goto z; +z: +x: + if (i) + dont_remove (); +y: ; +} + +/* { dg-final { scan-tree-dump-times "dont_remove \\(\\)" 1 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030824-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030824-1.c new file mode 100644 index 00000000000..328d33d1243 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030824-1.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +struct A +{ + int a,b; +}; + +int foo (int x, int y) +{ + int i, j; + struct A a,b; + + a.a = x; + b.b = y; + j = a.a; + i = b.b; + return i + j; +} + +/* The addition should be optimized into 'y+x'. */ +/* { dg-final { scan-tree-dump-times "y \\+ x" 1 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030824-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030824-2.c new file mode 100644 index 00000000000..5ed66d094a0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030824-2.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +struct A +{ + int a,b; +}; + +int foo (int x, int y) +{ + int i, j; + struct A a; + + a.a = x; + a.b = y; + j = a.a; + i = a.b; + return i + j; +} + +/* This function should be optimized into 'return y+x'. */ +/* { dg-final { scan-tree-dump-times "return y \\+ x" 1 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030825-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030825-1.c new file mode 100644 index 00000000000..440f75571d4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030825-1.c @@ -0,0 +1,28 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +void bla(void); + +void +foo(int c, int d) +{ + goto skip; + +ebef: + goto xxx; + +skip: + + if (c) + { +xxx:; + if (!c) + bla (); + } + + if (d) + goto ebef; +} + +/* Bla should not be optimized away. */ +/* { dg-final { scan-tree-dump-times "bla" 1 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030907-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030907-1.c new file mode 100644 index 00000000000..3bc5557cf00 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030907-1.c @@ -0,0 +1,26 @@ +/* PR optimization/12198 + + This was a miscompilation of a switch expressions because + the "Case Ranges" extension wasn't handled in tree-cfg.c. */ + +/* { dg-do compile } */ +/* { dg-options "-O -fdump-tree-optimized" } */ + +int main() +{ + int i; + i = 2; + switch (i) + { + case 1 ... 5: + goto L1; + default: + abort (); + goto L1; + } + L1: + exit(0); +} + +/* The abort() call clearly is unreachable. */ +/* { dg-final { scan-tree-dump-times "abort" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030907-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030907-2.c new file mode 100644 index 00000000000..47d60946e0c --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030907-2.c @@ -0,0 +1,30 @@ +/* PR optimization/12109 + + This would ICE in tree-ssa-dce.c:process_worklist() when + the function was expecting an SSA_NAME but found a VAR_DECL. */ + +/* { dg-do compile } */ +/* { dg-options "-O -ftree-dce" } */ + +void *do_it(void * dest, const void * src); +double *create_float(void); + +void parse_rvalue(void **DataPtr) +{ + double local = 0.0; + int terms = 1; + + *DataPtr = create_float(); + + switch (terms) + { + case 1: + *((double *)*DataPtr) = local; + break; + + case 2: + do_it(*DataPtr, &local); + break; + } +} + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030917-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030917-1.c new file mode 100644 index 00000000000..1b1441f0f9b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030917-1.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + + +extern int board[]; + +void +findbestextension (int blah, int blah2) +{ + int defval; + defval = def_val (board[blah2]); + if (blah) + defval = 0; + foo (defval); +} + +/* The argument to "foo" should be a variable, not a constant. */ +/* { dg-final { scan-tree-dump-times "foo .defval" 1 "ccp"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030917-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030917-2.c new file mode 100644 index 00000000000..2c08050c975 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030917-2.c @@ -0,0 +1,40 @@ +/* This test was causing an ICE in DCE because we were allowing void * + pointers to have a memory tag, which we were copying when doing copy + propagation. Since void * can never be de-referenced, its memory tag + was never renamed. */ + +/* { dg-do compile } */ +/* { dg-options "-O -ftree-dominator-opts" } */ + +typedef __SIZE_TYPE__ size_t; +typedef union tree_node *tree; +struct operands_d +{ + tree *def_op; +}; + +void +gt_ggc_mx_operands_d (void *x_p) +{ + struct operands_d *const x = (struct operands_d *) x_p; + if ((*x).def_op != ((void *) 0)) + { + size_t i0; + do + { + const void *const a__ = ((*x).def_op); + if (a__ != ((void *) 0) && a__ != (void *) 1) + ggc_set_mark (a__); + } + while (0); + for (i0 = 0; i0 < (size_t) (1); i0++) + { + do + { + if ((void *) (*x).def_op[i0] != ((void *) 0)) + gt_ggc_mx_lang_tree_node ((*x).def_op[i0]); + } + while (0); + } + } +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030917-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20030917-3.c new file mode 100644 index 00000000000..f7fabe5008c --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030917-3.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fno-tree-dominator-opts -fdump-tree-ccp" } */ + + +main () +{ + int variable = 0; + int p = 1; + while (1) + { + if (p) + break; + variable = variable + 1; + if (variable == 10) + break; + } + printf("%d\n", variable); +} + + +/* The argument to "printf" should be a constant, not a variable. */ +/* { dg-final { scan-tree-dump-times "printf.*, 0" 1 "ccp"} } */ + + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030918-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030918-1.c new file mode 100644 index 00000000000..719ea65f5bf --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030918-1.c @@ -0,0 +1,15 @@ +/* The compiler was failing to adjust pointer dereferences into array + references after propagating &equot[0] into p. */ + +/* { dg-do compile } */ +/* { dg-options "-O -ftree-dominator-opts" } */ + +static unsigned short equot[(6 +3)]; +int +foo (num) + unsigned short num[]; +{ + unsigned short *p = &equot[0]; + *p++ = num[0]; + *p++ = num[1]; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030920-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030920-1.c new file mode 100644 index 00000000000..e27764aecda --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030920-1.c @@ -0,0 +1,112 @@ +/* Jump threading was creating FALLTHRU edges out of blocks ending in + GOTO_EXPR. */ + +extern int frame_pointer_needed; + +struct value_data_entry +{ + unsigned int mode; + unsigned int oldest_regno; + unsigned int next_regno; +}; + +struct value_data +{ + struct value_data_entry e[53]; + unsigned int max_value_regs; +}; + +struct rtx_def +{ + unsigned int code: 16; + unsigned int mode : 8; + unsigned int jump : 1; + unsigned int call : 1; + unsigned int unchanging : 1; + unsigned int volatil : 1; + unsigned int in_struct : 1; + unsigned int used : 1; + unsigned integrated : 1; + unsigned frame_related : 1; + int fld[1]; +}; + +typedef struct rtx_def *rtx; + +enum machine_mode { VOIDmode, BImode, QImode, HImode, SImode, DImode, + TImode, OImode, PQImode, PHImode, PSImode, PDImode, QFmode, HFmode, + TQFmode, SFmode, DFmode, XFmode, TFmode, QCmode, HCmode, SCmode, + DCmode, XCmode, TCmode, CQImode, CHImode, CSImode, CDImode, CTImode, + COImode, V1DImode, V2QImode, V2HImode, V2SImode, V2DImode, V4QImode, + V4HImode, V4SImode, V4DImode, V8QImode, V8HImode, V8SImode, V8DImode, + V16QImode, V2HFmode, V2SFmode, V2DFmode, V4HFmode, V4SFmode, V4DFmode, + V8HFmode, V8SFmode, V8DFmode, V16SFmode, BLKmode, CCmode, CCGCmode, + CCGOCmode, CCNOmode, CCZmode, CCFPmode, CCFPUmode, MAX_MACHINE_MODE }; + +enum mode_class { MODE_RANDOM, MODE_INT, MODE_FLOAT, MODE_PARTIAL_INT, MODE_CC, + MODE_COMPLEX_INT, MODE_COMPLEX_FLOAT, + MODE_VECTOR_INT, MODE_VECTOR_FLOAT, + MAX_MODE_CLASS}; + +extern const unsigned char mode_size[(int) MAX_MACHINE_MODE]; +extern const enum mode_class mode_class[(int) MAX_MACHINE_MODE]; + +extern int target_flags; + +static void +copy_value (rtx dest, rtx src, struct value_data *vd) +{ + unsigned int dr = (((dest)->fld[0])); + unsigned int sr = (((src)->fld[0])); + unsigned int dn, sn; + unsigned int i; + + + + if (sr == dr) + return; + + + + if (dr == 7) + return; + + + if (frame_pointer_needed && dr == 6) + return; + + + dn = (((dr) >= 8 && (dr) <= (8 + 7)) || (((dr) >= (20 + 1) && (dr) <= ((20 + 1) + 7)) || ((dr) >= (((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) && (dr) <= ((((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) + 7))) || ((dr) >= (((20 + 1) + 7) + 1) && (dr) <= ((((20 + 1) + 7) + 1) + 7)) ? (((mode_class[(int) (((enum machine_mode) (dest)->mode))]) == MODE_COMPLEX_INT || (mode_class[(int) (((enum machine_mode) (dest)->mode))]) == MODE_COMPLEX_FLOAT) ? 2 : 1) : ((((enum machine_mode) (dest)->mode)) == TFmode ? ((target_flags & 0x00100000) ? 2 : 3) : (((enum machine_mode) (dest)->mode)) == TCmode ? ((target_flags & 0x00100000) ? 4 : 6) : (((mode_size[(int) (((enum machine_mode) (dest)->mode))]) + ((target_flags & 0x00100000) ? 8 : 4) - 1) / ((target_flags & 0x00100000) ? 8 : 4)))); + sn = (((sr) >= 8 && (sr) <= (8 + 7)) || (((sr) >= (20 + 1) && (sr) <= ((20 + 1) + 7)) || ((sr) >= (((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) && (sr) <= ((((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) + 7))) || ((sr) >= (((20 + 1) + 7) + 1) && (sr) <= ((((20 + 1) + 7) + 1) + 7)) ? (((mode_class[(int) (((enum machine_mode) (dest)->mode))]) == MODE_COMPLEX_INT || (mode_class[(int) (((enum machine_mode) (dest)->mode))]) == MODE_COMPLEX_FLOAT) ? 2 : 1) : ((((enum machine_mode) (dest)->mode)) == TFmode ? ((target_flags & 0x00100000) ? 2 : 3) : (((enum machine_mode) (dest)->mode)) == TCmode ? ((target_flags & 0x00100000) ? 4 : 6) : (((mode_size[(int) (((enum machine_mode) (dest)->mode))]) + ((target_flags & 0x00100000) ? 8 : 4) - 1) / ((target_flags & 0x00100000) ? 8 : 4)))); + if ((dr > sr && dr < sr + sn) + || (sr > dr && sr < dr + dn)) + return; + + + + + if (vd->e[sr].mode == VOIDmode) + set_value_regno (sr, vd->e[dr].mode, vd); + else if (sn < (unsigned int) (((sr) >= 8 && (sr) <= (8 + 7)) || (((sr) >= (20 + 1) && (sr) <= ((20 + 1) + 7)) || ((sr) >= (((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) && (sr) <= ((((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) + 7))) || ((sr) >= (((20 + 1) + 7) + 1) && (sr) <= ((((20 + 1) + 7) + 1) + 7)) ? (((mode_class[(int) (vd->e[sr].mode)]) == MODE_COMPLEX_INT || (mode_class[(int) (vd->e[sr].mode)]) == MODE_COMPLEX_FLOAT) ? 2 : 1) : ((vd->e[sr].mode) == TFmode ? ((target_flags & 0x00100000) ? 2 : 3) : (vd->e[sr].mode) == TCmode ? ((target_flags & 0x00100000) ? 4 : 6) : (((mode_size[(int) (vd->e[sr].mode)]) + ((target_flags & 0x00100000) ? 8 : 4) - 1) / ((target_flags & 0x00100000) ? 8 : 4)))) + && ((mode_size[(int) (vd->e[sr].mode)]) > ((target_flags & 0x00100000) ? 8 : 4) + ? 0 : 0)) + return; + + + + + else if (sn > (unsigned int) (((sr) >= 8 && (sr) <= (8 + 7)) || (((sr) >= (20 + 1) && (sr) <= ((20 + 1) + 7)) || ((sr) >= (((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) && (sr) <= ((((((((20 + 1) + 7) + 1) + 7) + 1) + 7) + 1) + 7))) || ((sr) >= (((20 + 1) + 7) + 1) && (sr) <= ((((20 + 1) + 7) + 1) + 7)) ? (((mode_class[(int) (vd->e[sr].mode)]) == MODE_COMPLEX_INT || (mode_class[(int) (vd->e[sr].mode)]) == MODE_COMPLEX_FLOAT) ? 2 : 1) : ((vd->e[sr].mode) == TFmode ? ((target_flags & 0x00100000) ? 2 : 3) : (vd->e[sr].mode) == TCmode ? ((target_flags & 0x00100000) ? 4 : 6) : (((mode_size[(int) (vd->e[sr].mode)]) + ((target_flags & 0x00100000) ? 8 : 4) - 1) / ((target_flags & 0x00100000) ? 8 : 4))))) + return; + + + + vd->e[dr].oldest_regno = vd->e[sr].oldest_regno; + + for (i = sr; vd->e[i].next_regno != (~(unsigned int) 0); i = vd->e[i].next_regno) + continue; + vd->e[i].next_regno = dr; + + + validate_value_data (vd); + +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030922-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20030922-1.c new file mode 100644 index 00000000000..8876071c81f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030922-1.c @@ -0,0 +1,32 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom3" } */ + + +union tree_node; +typedef union tree_node *tree; +enum tree_code +{ + BIND_EXPR, +}; +struct tree_common +{ + enum tree_code code:8; +}; +union tree_node +{ + struct tree_common common; +}; +tree +voidify_wrapper_expr (tree wrapper) +{ + switch (wrapper->common.code) + { + case BIND_EXPR: + if (wrapper->common.code != BIND_EXPR) + abort (); + } +} + + +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dom3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20030922-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20030922-2.c new file mode 100644 index 00000000000..322f3ab3891 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20030922-2.c @@ -0,0 +1,22 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom1" } */ + +struct rtx_def; +typedef struct rtx_def *rtx; +struct rtx_def +{ + int bb; +}; +static int *block_to_bb; +static int target_bb; +static int +rgn_rank (rtx insn1, rtx insn2) +{ + if (block_to_bb[insn1->bb] != block_to_bb[insn2->bb]) + if (block_to_bb[insn2->bb] == target_bb + && block_to_bb[insn1->bb] != target_bb) + return 1; +} + +/* There should be two IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 2 "dom1" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031015-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031015-1.c new file mode 100644 index 00000000000..62772b7b939 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031015-1.c @@ -0,0 +1,16 @@ +/* With tree-ssa, gcc.dg/20000724-1.c failed because we missed + a VOP of x in the asm statement. */ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-alias-vops" } */ + +struct s { int a; }; + +int +main(void) +{ + struct s x = { 0 }; + asm volatile ("" : : "r" (&x) : "memory"); + return 0; +} + +/* { dg-final { scan-tree-dump-times "VDEF" 2 "alias" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031021-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031021-1.c new file mode 100644 index 00000000000..4534ef34fc8 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031021-1.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +struct A +{ + int i : 8; +}; + +signed char c1, c2; +struct A a; + +int main() +{ + a.i = c1; + c2 = a.i; + return a.i; +} + +/* We should only store to a.i, not load from it. */ +/* { dg-final { scan-tree-dump-times "a.i" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031022-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031022-1.c new file mode 100644 index 00000000000..546e6b00759 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031022-1.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dom1" } */ + +typedef struct edge_def +{ + int z; +} *edge; +typedef struct basic_block_def +{ + edge pred; +} *basic_block; +extern struct basic_block_def entry_exit_blocks[2]; +void +blah (int arf) +{ + edge e; + e = (&entry_exit_blocks[1])->pred; + for ( ; ;) + if (arf) + break; + commit_edge_insertions (); + e = (&entry_exit_blocks[1])->pred; + foo (e); +} + +/* There should be two loads from entry_exit_blocks[1].pred. */ +/* { dg-final { scan-tree-dump-times "entry_exit_blocks.1..pred" 2 "dom1"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031031-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031031-1.c new file mode 100644 index 00000000000..baca2a00a94 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031031-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O1" } */ + +/* This program requires the SSA renamer to be run after the second DOM + pass. Test provided by Falk Hueffner as Bugzilla #12825. */ + +struct floppy_raw_cmd { + int flags, track; +} *raw_cmd, default_raw_cmd; + +void +setup_format_params (void) +{ + raw_cmd = &default_raw_cmd; + raw_cmd->track = 0; + raw_cmd->flags = 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-1.c new file mode 100644 index 00000000000..eb312cea1e2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-1.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for dead stores to an array. */ + +void foo (int testarray[]) +{ + testarray[0] = 0; + testarray[0]++; + if (testarray[0] != 1) + link_error (); +} + +/* There should be only one reference to "testarray". */ +/* { dg-final { scan-tree-dump-times "testarray" 1 "optimized" { xfail *-*-* } } } */ + +/* There should be no link_error calls. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-2.c new file mode 100644 index 00000000000..da430dc5813 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-2.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for dead stores to a struct. */ + +struct s +{ + char d; + int a, b; + double m; +}; + +void foo (struct s* teststruct) +{ + teststruct->a = 0; + teststruct->a++; + if (teststruct->a != 1) + link_error (); +} + +/* There should be only one reference to "teststruct". */ +/* { dg-final { scan-tree-dump-times "teststruct" 1 "optimized" { xfail *-*-* } } } */ + +/* There should be no link_error calls. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-3.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-3.c new file mode 100644 index 00000000000..ee7cb8a009d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-3.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for cprop on array elements. */ + +void foo (int testarray[]) +{ + testarray[0] = 0; + testarray[1] = 1; + testarray[0]++; + testarray[1]++; + if (testarray[0] != 1) + link_error (); + if (testarray[1] != 2) + link_error (); +} + +/* There should be no link_error calls. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-4.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-4.c new file mode 100644 index 00000000000..a288dacee47 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-4.c @@ -0,0 +1,29 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for cprop on fields of the same struct. */ + +struct s +{ + char d; + int a, b; + double m; +}; + + +void foo (struct s* r) +{ + r->a = 0; + r->b = 1; + r->a++; + r->b++; + if (r->a != 1) + link_error (); + if (r->b != 2) + link_error (); +} + +/* There should be no link_error calls. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-5.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-5.c new file mode 100644 index 00000000000..e543939c77b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-5.c @@ -0,0 +1,28 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for cprop on different fields of same type structs. */ + +struct s +{ + char d; + int a, b; + double m; +}; + +void foo2 (struct s* r, struct s* p) +{ + r->a = 0; + p->b = 1; + r->a++; + p->b++; + if (r->a != 1) + link_error (); + if (p->b != 2) + link_error (); +} + +/* There should be no link_error calls. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031106-6.c b/gcc/testsuite/gcc.dg/tree-ssa/20031106-6.c new file mode 100644 index 00000000000..39fb08b032a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031106-6.c @@ -0,0 +1,28 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* Check for copyprop on structs. */ + +struct s +{ + char d; + int a, b; + double m; +}; + +struct s foo (struct s r) +{ + struct s temp_struct1; + struct s temp_struct2; + struct s temp_struct3; + temp_struct1 = r; + temp_struct2 = temp_struct1; + temp_struct3 = temp_struct2; + return temp_struct3; +} + +/* There should be no references to any of "temp_struct*" + temporaries. */ +/* { dg-final { scan-tree-dump-times "temp_struct" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031113-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031113-1.c new file mode 100644 index 00000000000..a114379a7ad --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031113-1.c @@ -0,0 +1,30 @@ +/* PR optimization/12640 + + We used to get into an infinite loop while trying to + figure out `strlen (resultString)'. This showed up as + a stack overflow while compiling tk. */ + +/* { dg-do compile } */ +/* { dg-options "-O1" } */ + +int i; + +static void +SendEventProc (char *resultString) +{ + char *p; + + resultString = ""; + while (*p == '-') + { + if (p[2] == ' ') + { + resultString = p + 3; + } + } + for (;;) + { + i = strlen (resultString) + 1; + } +} + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20031216-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20031216-1.c new file mode 100644 index 00000000000..d3d39df3b11 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20031216-1.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +void +foo (int b) +{ + int a; + a = b + 2; + a--; + a--; + if (a != b) + link_error (); +} + +/* The comparison should be eliminated, there should be no reference + to link_error. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040121-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040121-1.c new file mode 100644 index 00000000000..6987e17d907 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040121-1.c @@ -0,0 +1,27 @@ + + +/* Test that (p!=0) + (q!=0) is computed as int, + not boolean */ +/* { dg-options "-O3" } */ +/* { dg-do run } */ +char *foo(char *p, char *q) { + int x = (p !=0) + (q != 0); + if (x==2) return "a"; else return 0; +} +extern char *bar(char*, char*) __attribute__((noinline)); +char *bar(char *first, char *last) +{ + int y; + if (!first) return last; + if (!last) return first; + if (*first == 'a') + return foo(first, last); + return 0; +} +main() { + char *p = "a", *q = "b"; + if (p) + if (bar(p,q)) + return 0; + abort(); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040204-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040204-1.c new file mode 100644 index 00000000000..426e2eab51a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040204-1.c @@ -0,0 +1,36 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +extern void link_error (void); + +/* + test that a condition is propagated inside an if +*/ + +void test5 (int x) +{ + extern int foo (int); + if (x == 0) + foo (x); + else if (x == 0 ) + link_error (); +} + +void test55 (int x, int y) +{ + int u; + if (x == 5 && y) + { + u = x + 22; + if (u != 27) + link_error (); + } +} + +/* There should be not link_error calls, if there is any the + optimization has failed */ +/* ??? Ug. This one may or may not fail based on how fold decides + that the && should be emitted (based on BRANCH_COST). Fix this + by teaching dom to look through && and register all components + as true. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040209-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040209-1.c new file mode 100644 index 00000000000..087715322b7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040209-1.c @@ -0,0 +1,52 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -Wuninitialized" } */ + +typedef union tree_node *tree; + +struct tree_common +{ + tree chain; +}; + +struct tree_decl +{ + struct tree_common common; + tree name; +}; + + +union tree_node +{ + struct tree_common common; + struct tree_decl decl; +}; + +int pedantic; + +void +finish_struct (tree t, tree fieldlist, tree attributes) +{ + union tree_node * x; + + if (pedantic) + { + x = fieldlist; + if (x->decl.name == 0) + { + while (x) + x = x->common.chain; + foo (fieldlist); + } + } + + x = fieldlist; + if (x) + { + do + { + x = x->common.chain; + } while (x != 0); + } + + bar1 (&fieldlist); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040210-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040210-1.c new file mode 100644 index 00000000000..9eb7905aef0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040210-1.c @@ -0,0 +1,32 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-phiopt1-details" } */ + + +void abort(void); +void exit(int); + +int x, y; + +static void +init_xy(void) +{ + x = 3; + y = 2; +} + +void +test4(void) +{ + init_xy(); + if ((x < y ? x++ : y++) != 2) + abort (); +} + +int +main(){ + test4 (); + exit (0); +} + +/* Should have no more than two ifs left after straightening. */ +/* { dg-final { scan-tree-dump-times "if " 2 "phiopt1"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040211-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040211-1.c new file mode 100644 index 00000000000..5d6e07940a5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040211-1.c @@ -0,0 +1,40 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce" } */ + + + + +struct rtx_def; +typedef struct rtx_def *rtx; +extern const char rtx_class[]; +union rtunion_def +{ + rtx rtx; +}; +typedef union rtunion_def rtunion; +struct rtx_def +{ + int code; + rtunion fld[1]; +}; +static int +can_move_up (rtx insn, int n_insns) +{ + while (n_insns > 0) + { + insn = (((insn)->fld[1]).rtx); + if (((rtx_class[(int) (((insn)->code))]) == 'i')) + n_insns--; + } + return n_insns <= 0; +} +int +com (rtx insn, int blah) +{ + if (!can_move_up (insn, blah)) + foo (); +} + +/* Cddce cannot remove possibly infinite loops and there is no way how to + determine whether the loop in can_move_up ends. */ +/* { dg-final { scan-tree-dump "if " "cddce"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040216-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040216-1.c new file mode 100644 index 00000000000..7585905a4da --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040216-1.c @@ -0,0 +1,18 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dse1-details" } */ + +foo(int *z, int *y, int xx) +{ + *z = 1; + if (xx) + xx = 20; + else + xx = 30; + *z = 2; + *z = 3; + return xx; +} + +/* We should convert two COND_EXPRs into straightline code. */ +/* { dg-final { scan-tree-dump-times "Deleted dead store" 2 "dse1"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040302-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040302-1.c new file mode 100644 index 00000000000..ef59b041030 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040302-1.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 --param global-var-threshold=0" } */ + +/* Test for .GLOBAL_VAR not being renamed into SSA after alias analysis. + provided by Dale Johannesen in PR 14266. */ + +void foo() { bar (); } +main () { foo (); } diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040305-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040305-1.c new file mode 100644 index 00000000000..2d098d50e1d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040305-1.c @@ -0,0 +1,30 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce -fdump-tree-forwprop1-details" } */ + +int abarney[2]; +int afred[1]; + +void foo(int edx, int eax) +{ + if (eax == 100) + { + if (edx == 1) + { + abarney[0] = 5; + abarney[1] = 6; + } + } + if (eax == 100) + { + if (-- edx == 0) + afred[0] = 2; + } +} + + +/* Verify that we did a forward propagation. */ +/* { dg-final { scan-tree-dump-times "Replaced" 1 "forwprop1"} } */ + +/* After cddce we should have two IF statements remaining as the other + two tests can be threaded. */ +/* { dg-final { scan-tree-dump-times "if " 2 "cddce"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040313-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040313-1.c new file mode 100644 index 00000000000..0ad144c03dd --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040313-1.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O3" } */ + +/* Test provided by Volker Reichelt in PR 14553. The redundant PHI + node elimination pass was not using the right API functions to + propagate pointers, which resulted in dereferenced pointers that + did not have memory tags associated with them. */ + +void foo(int* p) +{ + int i; + for (i=1; i>0; --i, ++p) + *p=0; +} + +void bar(int* p) { foo(p); } diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040319-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040319-1.c new file mode 100644 index 00000000000..571c2aeabad --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040319-1.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +/* Test derived from PR 14643. When a function has no addressable + variables but 2 or more pointers have conflicting memory tags, they + were not being processed by the type based alias analyzer, + resulting in optimizations removing a non-redundant load. */ + +struct bar { int count; int *arr;}; + +void foo (struct bar *b) +{ + b->count = 0; + *(b->arr) = 2; + if (b->count == 0) /* b->count can't be assumed to be 0 here. */ + abort (); +} + +main () +{ + struct bar x; + x.arr = &x.count; + foo (&x); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040324-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040324-1.c new file mode 100644 index 00000000000..15eb0d62381 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040324-1.c @@ -0,0 +1,31 @@ +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +/* Ensure that BIT_FIELD_REFs gets the appropriate VUSE. + Contributed by Paolo Bonzini <bonzini@gnu.org>. + + This testcase actually never triggered in the CVS repo, but it did + in my local tree and it seems worth testing. In this test, the if's + are folded to BIT_FIELD_REFs but the VUSEs were erroneously left out. + Therefore, DOM did not see that i was modified between the two ifs + and optimized away the second if. */ + +struct x +{ + unsigned b:1; + unsigned c:1; +}; + +struct x i = { 1, 1 }; + +int +main () +{ + i.b = 1; + if (i.b == 1 && i.c == 0) + exit (0); + i.c = 0; + if (i.b == 1 && i.c == 0) + exit (0); + abort (); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040326-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040326-1.c new file mode 100644 index 00000000000..c29655a24fd --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040326-1.c @@ -0,0 +1,29 @@ +/* { dg-options "-O2 -fno-inline-functions" } */ +/* { dg-do run } */ +/* When there are no call-clobbered variables, we should still create + a .GLOBAL_VAR to model the side effects of functions. Without it, + we were moving the call to Faref() inside the second call to + Faset(). */ +main () +{ + int table, c, elt; + int tem = Faref (table, elt); + Faset (table, elt, c); + Faset (table, c, tem);/* tem cannot be replaced with Faref (table, elt) */ + exit (0); +} + +int j = 0; + +int __attribute__ ((noinline)) Faref (table, elt) +{ + j = 1; + return 0; +} + +int __attribute__ ((noinline)) Faset (table, elt, c) +{ + if (j != 1) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040326-2.c b/gcc/testsuite/gcc.dg/tree-ssa/20040326-2.c new file mode 100644 index 00000000000..a3e16ad451e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040326-2.c @@ -0,0 +1,63 @@ +/* { dg-options "-O2 -fno-inline-functions" } */ +/* { dg-do run } */ + +/* Gimplification problem exposed by zsh. All the side-effects in + function arguments and in the called expression should happen + before the actual function call. */ +int A; + +typedef void (*fnptr) (void); +fnptr *F; + +void +foo (int x) +{ + if (A == x) + abort (); +} + +void +bar (int x, int y) +{ + if (x == 5 || y != 3) + abort (); +} + +void +boz (void) +{ + abort (); +} + +void +baz (void) +{ + if (*F != boz) + abort (); +} + +fnptr B[2] = { baz, boz }; + +main () +{ + int b, c; + + /* The gimplifier was emitting A++ after the call to foo. */ + A = 5; + foo (A++); + + /* The increment to 'b' and 'c' must happen before the call. However, + the first argument to bar() must be the original value of 'b', while + the second argument must be the new value of 'c'. */ + b = 4; + c = 2; + bar (b++, ++c); + + /* This call via function pointer *F should go to baz, but F should + be incremented before the actual call (i.e., right before the + call F should be pointing to boz). */ + F = &B[0]; + (*F++) (); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040408-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040408-1.c new file mode 100644 index 00000000000..6578be543a0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040408-1.c @@ -0,0 +1,51 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ +/* Make sure that when a variable with an NMT is marked for renaming + that the NMT's aliases are also marked for renaming. */ + +static int eiisnan (short unsigned int *x) +{ + int i; + + if( x[i] != 0 ) + return(1); +} + +static int eiisinf (unsigned short *x) +{ + if (eiisnan (x)) + return (0); + + if ((x[1] & 0x7fff) == 0x7fff) + return (1); +} + +static void toe64(short unsigned int *a, short unsigned int *b) +{ + register unsigned short *p, *q; + unsigned short i; + + q = b + 4; + + if (eiisinf (a)); + + for( i=0; i<4; i++ ) + *q-- = *p++; +} + +static int asctoeg(short unsigned int *y, int oprec) +{ + unsigned short yy[13]; + char *s; + + while( *s == ' ' ) + ++s; + + toe64( yy, y ); +} + +long double _strtold (char *s, char **se) +{ + long double x; + asctoeg( (unsigned short *)&x, 64 ); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/20040430-1.c b/gcc/testsuite/gcc.dg/tree-ssa/20040430-1.c new file mode 100644 index 00000000000..73ee8da85a6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/20040430-1.c @@ -0,0 +1,25 @@ +/* PR middle-end/14470. Similar to + gcc.c-torture/execute/20040313-1.c, but with a compile time test to + make sure the second if() is removed. We should actually get rid + of the first if() too, but we're not that smart yet. */ + +/* { dg-do run } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + + +extern void abort(void); + +int main() +{ + int t[1025] = { 1024 }, d; + + d = 0; + d = t[d]++; + if (t[0] != 1025) + abort(); + if (d != 1024) + abort(); + return 0; +} + +/* { dg-final { scan-tree-dump-times "if " 1 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/asm-1.c b/gcc/testsuite/gcc.dg/tree-ssa/asm-1.c new file mode 100644 index 00000000000..ad92408f170 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/asm-1.c @@ -0,0 +1,16 @@ +/* Make sure that gcc understands that an in/out operand is a use as well + as a def. */ + +/* { dg-do compile } */ +/* { dg-options "-O -fdump-tree-optimized" } */ + +void f() +{ + int i = 42; + int j = 63; + + asm ("": "=m"(i), "+r"(j) : "m"(i)); +} + +/* { dg-final { scan-tree-dump-times "42" 1 "optimized" } } */ +/* { dg-final { scan-tree-dump-times "63" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cfgcleanup-1.c b/gcc/testsuite/gcc.dg/tree-ssa/cfgcleanup-1.c new file mode 100644 index 00000000000..4d22a42814a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/cfgcleanup-1.c @@ -0,0 +1,18 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dce1" } */ +void +cleanup (int a, int b) +{ + if (a) + if (b) + a = 1; + else + b = 1; + else if (a) + a = 1; + else + b = 1; + return; +} +/* Dce should get rid of the initializers and cfgcleanup should elliminate ifs */ +/* { dg-final { scan-tree-dump-times "if " 0 "dce1"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/copy-headers.c b/gcc/testsuite/gcc.dg/tree-ssa/copy-headers.c new file mode 100644 index 00000000000..efe831beab5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/copy-headers.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-ch-details" } */ + +extern int foo (int); + +void bla (void) +{ + int i, n = foo (0); + + for (i = 0; i < n; i++) + foo (i); +} + +/* There should be a header scheduled for duplication. */ +/* { dg-final { scan-tree-dump-times "Scheduled" 1 "ch"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/sra-1.c b/gcc/testsuite/gcc.dg/tree-ssa/sra-1.c new file mode 100644 index 00000000000..652f402dc83 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/sra-1.c @@ -0,0 +1,72 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +/* Tests for SRA. */ + +typedef struct teststruct +{ + double d; + char f1; +} teststruct; + +void +copystruct1 (teststruct param) +{ + teststruct local; + param.f1 = 0; + local = param; + if (local.f1 != 0) + link_error (); +} + +void +copystruct11 (teststruct *param) +{ + teststruct local; + param->f1 = 0; + local = *param; + if (local.f1 != 0) + link_error (); +} + +void +copystruct111 (teststruct param) +{ + teststruct *local = ¶m; + param.f1 = 0; + if (local->f1 != 0) + link_error (); +} + +teststruct globf; +void +copystruct1111 (void) +{ + teststruct local; + globf.f1 = 0; + local = globf; + if (local.f1 != 0) + link_error (); +} + +void +copystruct11111 (void) +{ + teststruct *local = &globf; + globf.f1 = 0; + if (local->f1 != 0) + link_error (); +} + +void +copystruct111111 (teststruct param) +{ + static teststruct local; + param.f1 = 0; + local = param; + if (local.f1 != 0) + link_error (); +} + +/* There should be no referenc to link_error. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/sra-2.c b/gcc/testsuite/gcc.dg/tree-ssa/sra-2.c new file mode 100644 index 00000000000..fa8bea51bc7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/sra-2.c @@ -0,0 +1,25 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +/* Test for SRA. */ + +typedef struct teststruct +{ + double d; + char f1; +} teststruct; + + +void +copystruct11 (teststruct *param) +{ + static teststruct local; + param->f1 = 0; + local = *param; + if (local.f1 != 0) + link_error (); +} + + +/* There should be no reference to link_error. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/sra-3.c b/gcc/testsuite/gcc.dg/tree-ssa/sra-3.c new file mode 100644 index 00000000000..f6ffc575938 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/sra-3.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +/* Test for SRA. */ + +typedef struct teststruct +{ + double d; + char f1; +} teststruct; + +teststruct *globf1; + +extern void link_error (void); + +void +copystruct1 (void) +{ + teststruct local; + globf1->f1 = 0; + local = *globf1; + if (local.f1 != 0) + link_error (); +} + +/* There should be no reference to link_error. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-1.c new file mode 100644 index 00000000000..419cc95c71e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-1.c @@ -0,0 +1,74 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + +extern void link_error (void); + +/* check folding */ + +void test1 (void) +{ + unsigned int l = 3 * 4 - 5 / 2; + if (l != 10) + link_error (); +} + +void test11 (void) +{ + unsigned int l = (((((((3 / 2 + 2) * 4) & 7) ^ 3) % 8) << 2) + 1) >> 2; + if (l != 7) + link_error (); +} + +/* cprop in a basic block */ +void test111 (void) +{ + unsigned int l0 = 3 / 2 + 2; + unsigned int l1 = l0 * 4; + unsigned int l2 = 7; + unsigned int l3 = l1 & l2; + unsigned int l4 = 3; + unsigned int l5 = l3 ^ l4; + unsigned int l6 = 8; + unsigned int l7 = l5 % l6; + unsigned int l8 = 2; + unsigned int l9 = l7 << l8; + unsigned int l10 = l9 + 1; + unsigned int l11 = l10 >> 2; + if (l11 != 7) + link_error (); +} + + +/* cprop after an if statement */ +void test1111 (int p) +{ + int l = 53; + if (p) + { + if ((67 + l - 25) != 95) + link_error (); + } + else + { + if ((93 - l + 25) != 65) + link_error (); + } +} + +/* cprop after a loop */ +void test11111 (int p, int q, int r) +{ + int l = 53; + while (p < r) + { + if ((67 + l - 25) != 95) + link_error (); + p -= q; + } +} + + + +/* There should be not link_error calls, if there is any the + optimization has failed */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "ccp"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-10.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-10.c new file mode 100644 index 00000000000..091703a1017 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-10.c @@ -0,0 +1,31 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-fab" } */ + +/* Check that we fold strlen of equally long strings, and that we do not + fail to terminate when there is a nontrivial cycle in the corresponding + ssa graph. */ + +void foo(int i) +{ + char *s = "abcde"; + + if (i) + { + s = "defgh"; + goto middle; + } + +start: + + bla (); + +middle: + + if (bla ()) + goto start; + + bar (strlen (s)); +} + +/* There should be no calls to strlen. */ +/* { dg-final { scan-tree-dump-times "strlen" 0 "fab"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-11.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-11.c new file mode 100644 index 00000000000..b7f307964a6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-11.c @@ -0,0 +1,41 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +/* Test for CPROP across a DAG. */ + +int test111 (int param) +{ + int a, b, c; + if (param) { + a = 3; + b = 2; + } + else { + a = 2; + b = 3; + } + c = a + b; + if (c != 5) + return 2; + return 0; +} + +int test1111 (int param) +{ + _Bool a, b, c; + if (param) { + a = 1; + b = 0; + } + else { + a = 0; + b = 1; + } + c = a && b; + if (c) + return 2; + return 0; +} + +/* All ifs should be eliminated. */ +/* { dg-final { scan-tree-dump-times "if" 0 "optimized" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-2.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-2.c new file mode 100644 index 00000000000..b3c87fdc7b3 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-2.c @@ -0,0 +1,171 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + +extern void link_error (void); + + +/* check that cprop for variables of different types still works even + if function calls or assignments to different types of data are + interposed. */ + +int test7 (int *intarr) +{ + extern int foo7 (int); + int u = 7, v1; + foo7 (u); + v1 = u; + if (v1 != 7) + link_error (); + return v1; +} + +int test77 (int *arr) +{ + int u = 7, v1; + arr[0] = 4; + v1 = u; + if (v1 != 7) + link_error (); + return v1 + arr[0]; +} + +int test777 (void) +{ + extern int foo(int *); + int u = 7, v1; + static int sarr[10]; + sarr[0] = 4; + v1 = u; + if (v1 != 7) + link_error (); + foo (sarr); + return v1 + sarr[0]; +} + +int garr[10]; +int test7777 (void) +{ + int u = 7, v1; + garr[0] = 4; + v1 = u; + if (v1 != 7) + link_error (); + return v1 + garr[0]; +} + +int test88 (int *arr) +{ + static int l; + int v1; + l = 8; + arr[0] = 4; + v1 = l; + if (v1 != 8) + link_error (); + l = foo88 (l); + return v1 + arr[0]; +} + +int test888 (void) +{ + static int l; + extern int foo(int *); + int v1; + static int sarr[10]; + l = 8; + sarr[0] = 4; + v1 = l; + if (v1 != 8) + link_error (); + foo (sarr); + l = foo88(l); + return v1 + sarr[0]; +} + +int test8888 (void) +{ + static int l; + int v1; + l = 8; + garr[0] = 4; + v1 = l; + if (v1 != 8) + link_error (); + return v1 + garr[0]; +} + + + +/* global var */ +int g9; +int garr9[10]; +int test9 (int *intarr) +{ + extern int foo9 (int) __attribute__ ((const)); + int h, v; + g9 = 9; + h = foo9 (g9); + v = g9; + if (v != 9) + link_error (); + return g9; +} + +int test99 (int *intarr) +{ + extern int foo9 (int) __attribute__ ((pure)); + int h, v; + g9 = 9; + h = foo9 (g9); + v = g9; + if (v != 9) + link_error (); + return g9; +} + +extern int foo99 (int); + +int test999 (int *arr) +{ + static int l; + int v1; + g9 = 9; + l = 4; + v1 = g9; + if (v1 != 9) + link_error (); + l = foo99 (l); + return v1 + l; +} + + +int test9999 (void) +{ + int v1; + static int sarr[10]; + g9 = 9; + sarr[0] = 4; + v1 = g9; + if (v1 != 9) + link_error (); + foo (sarr); + g9 = foo99 (g9); + return v1 + sarr[0]; +} + + +int test99999 (void) +{ + int v1; + g9 = 9; + garr9[0] = 4; + v1 = g9; + if (v1 != 9) + link_error (); + return v1 + garr9[0]; +} + + +/* There should be not link_error calls, if there is any the + optimization has failed */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "ccp"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-3.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-3.c new file mode 100644 index 00000000000..15d43cb7ef7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-3.c @@ -0,0 +1,134 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + +extern void link_error (void); + +/* some addresses clearly cannot be equal, check that some address + expressions can be evaluated as constants */ + +char g1, g2; +void test6 (char p1, char p2) +{ + char l1 = 1, l2 = 2; + static char s1 = 5, s2 = 7; + if (&l1 == &l2) + link_error (); + + if (&p1 == &p2) + link_error (); + + if (&s1 == &s2) + link_error (); + + if (&g1 == &g2) + link_error (); + + if (&p1 == &l1) + link_error (); + + if (&p1 == &s1) + link_error (); + + if (&p1 == &l2) + link_error (); + + if (&p1 == &g1) + link_error (); + + if (&l1 == &g1) + link_error (); + + if (&s1 == &g1) + link_error (); +} + +extern void *alloc (int) __attribute__ ((malloc)); +char gca1[128]; +char* __restrict__ rgc1; +char* test66 (char * __restrict__ rp1, char * __restrict__ rp2, char *p1) +{ + char * __restrict__ rl1 = p1; + char * l1 = (char*) alloc (20); + + if (l1 == rgc1) + link_error (); + + if (l1 == rp1) + link_error (); + + if (l1 == rl1) + link_error (); + + if (l1 == gca1) + link_error (); + + if (rl1 == rgc1) + link_error (); + + if (rl1 == rp1) + link_error (); + + if (rl1 == gca1) + link_error (); + + if (rp1 == rp2) + link_error (); + + if (rp1 == rgc1) + link_error (); + + if (rp1 == gca1) + link_error (); + + if (gca1 == rgc1) + link_error (); + +} + +int gci1[128]; +int* __restrict__ rgi1; +int* test666 (int * __restrict__ rp1, int * __restrict__ rp2, int *p1) +{ + int * __restrict__ rl1 = p1; + int * l1 = (int*) alloc (20); + + if (l1 == rgi1) + link_error (); + + if (l1 == rp1) + link_error (); + + if (l1 == rl1) + link_error (); + + if (l1 == gci1) + link_error (); + + if (rl1 == rgi1) + link_error (); + + if (rl1 == rp1) + link_error (); + + if (rl1 == gci1) + link_error (); + + if (rp1 == rp2) + link_error (); + + if (rp1 == rgi1) + link_error (); + + if (rp1 == gci1) + link_error (); + + if (gci1 == rgi1) + link_error (); +} + + +/* There should be not link_error calls, if there is any the + optimization has failed */ +/* ??? While we indeed don't handle some of these, a couple of the + restrict tests are incorrect. */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "ccp" { xfail *-*-* } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-7.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-7.c new file mode 100644 index 00000000000..ba6db18e00e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-7.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + +extern void link_error (void); + +/* tests to check if cprop works when using non-return functions */ + +extern int not_returning (int) __attribute__ ((noreturn)); + +int b; +int test7 (int a) +{ + b = 7; + if (a) + { + not_returning (a); + } + if (b != 7) + link_error (); + return b; +} + + +/* There should be not link_error calls, if there is any the + optimization has failed */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "ccp"} } */ + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-9.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-9.c new file mode 100644 index 00000000000..4656558814e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-ccp-9.c @@ -0,0 +1,54 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-ccp" } */ + +/* Check that cprop works for assignments to array elements and structs. */ + +struct foo { + int a; +}; + +extern void link_error (void); + +void +test9 (struct foo f) +{ + f.a = 0; + if (f.a != 0) + link_error (); +} + +void +test99 (struct foo *f) +{ + f->a = 0; + if (f->a != 0) + link_error (); +} + +void +test999 (int *arr) +{ + *arr = 0; + if (*arr != 0) + link_error (); +} + +void +test9999 (int *arr) +{ + arr[13] = 0; + if (arr[13] != 0) + link_error (); +} + +void +test99999 (int *arr, int j) +{ + arr[j] = 0; + if (arr[j] != 0) + link_error (); +} + +/* There should be no link_error calls, if there is any, the + optimization has failed */ +/* { dg-final { scan-tree-dump-times "link_error" 0 "ccp"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-1.c new file mode 100644 index 00000000000..e95cf67cde0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-1.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dce3" } */ + +int t() __attribute__ ((const)); +q() +{ + int i = t(); + if (!i) + i = t(); +} +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dce3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-2.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-2.c new file mode 100644 index 00000000000..64525141beb --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-2.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-dce3" } */ + +/* We should notice constantness of this function. */ +int t(int a) +{ + return a+1; +} +q() +{ + int i = t(1); + if (!i) + i = t(1); +} +/* There should be no IF conditionals. */ +/* { dg-final { scan-tree-dump-times "if " 0 "dce3"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-3.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-3.c new file mode 100644 index 00000000000..efaa3affaf6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dce-3.c @@ -0,0 +1,29 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce" } */ + +int main(void) +{ + unsigned i, j; + + for (i = 1, j = 0; i != 0; i+=2) + { + j += 500; + if (j % 7) + { + j++; + } + else + { + j--; + } + } + + return 0; +} + +/* We should eliminate the inner condition, but the loop must be preserved + as it is infinite. Therefore there should be just one phi node (for i): */ +/* { dg-final { scan-tree-dump-times "PHI " 1 "cddce"} } */ + +/* And one if (for the exit condition of the loop): */ +/* { dg-final { scan-tree-dump-times "if " 1 "cddce"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-ccp-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-ccp-1.c new file mode 100644 index 00000000000..db7b4b49ed2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-ccp-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom1-details" } */ +int t(int a) __attribute__ ((const)); +void abort (void); +int +ccp(int b) +{ + int a=1; + a++; + a++; + a++; + if (b) + abort(); + return a; +} +/* We should propagate constant 4 into return. */ +/* { dg-final { scan-tree-dump-times "Replaced.*with constant '4'" 1 "dom1"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-cse-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-cse-1.c new file mode 100644 index 00000000000..4e4ed8c912f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-cse-1.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom2-details" } */ +int t(int a) __attribute__ ((const)); +void q (void); +void +threading(int a,int b) +{ + if (t(a)) + { + if (t(a)) + q(); + } +} +/* We should thread the jump twice and eliminate it. Test this in + DOM2, after aliases have been computed. */ +/* { dg-final { scan-tree-dump-times "Replaced.* t " 1 "dom2"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-1.c new file mode 100644 index 00000000000..e4ae8ea0b92 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-dom1-details" } */ +void t(void); +void q(void); +void q1(void); +void +threading(int a,int b) +{ + if (a>b) + t(); + else + q(); + if (a<=b) + q1(); +} +/* We should thread the jump twice and elliminate it. */ +/* { dg-final { scan-tree-dump-times "Threaded" 2 "dom1"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-1.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-1.c new file mode 100644 index 00000000000..43eb6e0848f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-1.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-pre-stats" } */ +int main(int argc, char **argv) +{ + int a; + int b; + int c; + b = argc + 1; + c = argc + 2; + a = b + c; + if (argc * 2) + { + c = argc + 3; + } + printf ("%d, %d\n", a, b + c); +} +/* We should eliminate one evaluation of b + c along the main path, + causing one reload. */ +/* { dg-final { scan-tree-dump-times "Reloads:1" 1 "pre"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-2.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-2.c new file mode 100644 index 00000000000..e264c50f920 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-pre-2.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-pre-stats" } */ +int motion_test1(int data, int data_0, int data_3, int v) +{ + int i; + int t, u; + + if (data) + i = data_0 + data_3; + else { + v = 2; + i = 5; + } + t = data_0 + data_3; + u = i; + return v * t * u; +} +/* We should eliminate one computation of data_0 + data_3 along the + main path, causing one reload. */ +/* { dg-final { scan-tree-dump-times "Reloads:1" 1 "pre"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailcall-1.c b/gcc/testsuite/gcc.dg/tree-ssa/tailcall-1.c new file mode 100644 index 00000000000..c2a85940a30 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailcall-1.c @@ -0,0 +1,18 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-tailc-details" } */ +int q(int a); +int *v; +int +t(int a) +{ + int r,r1; + if (a) + r1=r = q(a-1); + else + return 0; + /* Dead alloca should not disturb us. */ + if (r!=r1) + v=alloca(r); + return r; +} +/* { dg-final { scan-tree-dump-times "Found tail call" 1 "tailc"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailcall-2.c b/gcc/testsuite/gcc.dg/tree-ssa/tailcall-2.c new file mode 100644 index 00000000000..7f3415444ff --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailcall-2.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-tailc-details" } */ +/* Test provided by Richard Earnshaw in PR 14312. */ + +void bar (int i); +void baz (int *); + +void +foo (int *x) +{ + if (*x < 0) + { + baz (x); + return; + } + bar (*x); +} + +/* The test has no local call-clobbered variables. Only the memory + tag for 'x' is call-clobbered. And since tags are not real + variables, they ought to be ignored. There should be two tail + calls here. */ +/* { dg-final { scan-tree-dump-times "Found tail call" 2 "tailc"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c new file mode 100644 index 00000000000..dc61c1324bd --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-1.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-tailr-details" } */ +int +t(int a) +{ + if (a) + return t(a-1); + else + return 0; +} +/* { dg-final { scan-tree-dump-times "Eliminated tail recursion" 1 "tailr"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c new file mode 100644 index 00000000000..095993bc133 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-2.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-tailr-details" } */ +int +t(char *a) +{ + static char p[100]; + if (a) + return t(p); + else + return 0; +} +/* { dg-final { scan-tree-dump-times "Eliminated tail recursion" 1 "tailr"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c new file mode 100644 index 00000000000..097a1de0e4e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-3.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-tailr-details" } */ +int +t(int a) +{ + int r; + if (a) + r = t(a-1); + else + return 0; + if (r) + r=r; + return r; +} +/* { dg-final { scan-tree-dump-times "Eliminated tail recursion" 1 "tailr"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c new file mode 100644 index 00000000000..71a4f6716a1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-4.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-tailr-details" } */ +int +t(int a) +{ + int r; + if (a&1) + r = t(a-1); + else if (a) + r = t(a-2); + else + return 0; + if (r) + r=r; + return r; +} +/* { dg-final { scan-tree-dump-times "Eliminated tail recursion" 2 "tailr"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c new file mode 100644 index 00000000000..2940a5019bd --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tailrecursion-5.c @@ -0,0 +1,72 @@ +/* { dg-do run } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +int sum (int n) +{ + if (n == 0) + return 0; + + return n + sum (n - 1); +} + +int fac (int n) +{ + if (n == 0) + return 1; + + return n * fac (n - 1); +} + +int sq_sum (int n) +{ + if (n == 0) + return 0; + + return n * n + sq_sum (n - 1); +} + +int pow2m1 (int n) +{ + if (n == 0) + return 0; + + return 2 * pow2m1 (n - 1) + 1; +} + +int fib (int n) +{ + if (n <= 1) + return 1; + + return fib (n - 2) + fib (n - 1); +} + +int main(void) +{ + if (sum (5) != 15) + abort (); + + if (fac (5) != 120) + abort (); + + if (sq_sum (5) != 55) + abort (); + + if (pow2m1 (5) != 31) + abort (); + + if (fib (5) != 8) + abort (); + + exit (0); +} + +/* There is one call of sum in main and then 2 instances of the word in + ;; Function sum (sum) and one in the function header. */ +/* { dg-final { scan-tree-dump-times "\\msum\\M" 4 "optimized"} } */ +/* { dg-final { scan-tree-dump-times "\\mfac\\M" 4 "optimized"} } */ +/* { dg-final { scan-tree-dump-times "\\msq_sum\\M" 4 "optimized"} } */ +/* { dg-final { scan-tree-dump-times "\\mpow2m1\\M" 4 "optimized"} } */ + +/* There is one recursive call to fib. */ +/* { dg-final { scan-tree-dump-times "\\mfib\\M" 5 "optimized"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/tree-ssa.exp b/gcc/testsuite/gcc.dg/tree-ssa/tree-ssa.exp new file mode 100644 index 00000000000..7b3403c957d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/tree-ssa.exp @@ -0,0 +1,36 @@ +# Copyright (C) 1997,2002,2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# GCC testsuite that uses the `dg.exp' driver. + +# Load support procs. +load_lib gcc-dg.exp + +# If a testcase doesn't have special options, use these. +global DEFAULT_CFLAGS +if ![info exists DEFAULT_CFLAGS] then { + set DEFAULT_CFLAGS " -ansi -pedantic-errors" +} + +# Initialize `dg'. +dg-init + +# Main loop. +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[cS\]]] \ + "" $DEFAULT_CFLAGS + +# All done. +dg-finish diff --git a/gcc/testsuite/gcc.dg/tree-ssa/useless-1.c b/gcc/testsuite/gcc.dg/tree-ssa/useless-1.c new file mode 100644 index 00000000000..3274998d1fc --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/useless-1.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-useless" } */ + +void +foo (void) +{ + int i, a; + for (i = 0; i < 10; i++) + { a = i; } +} + +/* There should be three gotos in the dump. If one was removed + in the loop exit condition, it would be re-introduced during + GIMPLE lowering, at the cost of an extra statement, label, + and basic block. */ +/* { dg-final { scan-tree-dump-times "goto" 3 "useless"} } */ diff --git a/gcc/testsuite/gcc.dg/uninit-1.c b/gcc/testsuite/gcc.dg/uninit-1.c index 91838810fda..060ec250ba7 100644 --- a/gcc/testsuite/gcc.dg/uninit-1.c +++ b/gcc/testsuite/gcc.dg/uninit-1.c @@ -13,7 +13,7 @@ extern void free (void *); void remove_dupes (struct list *el) { - struct list *p, *q, *r; /* { dg-bogus "r" "uninitialized variable warning" { xfail *-*-* } } */ + struct list *p, *q, *r; /* { dg-bogus "r" "uninitialized variable warning" } */ for (p = el; p; p = p->next) { diff --git a/gcc/testsuite/gcc.dg/uninit-11.c b/gcc/testsuite/gcc.dg/uninit-11.c new file mode 100644 index 00000000000..5251f0a2a70 --- /dev/null +++ b/gcc/testsuite/gcc.dg/uninit-11.c @@ -0,0 +1,42 @@ +/* Positive test for uninitialized variables. */ +/* { dg-do compile } */ +/* { dg-options "-O -Wuninitialized" } */ + +int sink; + +void f1(int parm) /* { dg-bogus "uninitialized" "parameter" } */ +{ + sink = parm; /* { dg-bogus "uninitialized" "parameter" } */ +} + +void f2(void) +{ + int x; + sink = x; /* { dg-warning "is used" "unconditional" } */ +} + +void f3(int p) +{ + int x; /* { dg-warning "may be used" "conditional" } */ + if (p) + x = p; + sink = x; +} + +void f4(int p) +{ + int x; /* { dg-bogus "uninitialized" "easy if" } */ + if (p) + x = 1; + else + x = 2; + sink = x; +} + +void f5(void) +{ + int x, i; /* { dg-bogus "uninitialized" "easy loop" } */ + for (i = 0; i < 10; ++i) + x = 1; + sink = x; +} diff --git a/gcc/testsuite/gcc.dg/uninit-2.c b/gcc/testsuite/gcc.dg/uninit-2.c index 5035a309ebd..352bbac06c5 100644 --- a/gcc/testsuite/gcc.dg/uninit-2.c +++ b/gcc/testsuite/gcc.dg/uninit-2.c @@ -25,7 +25,7 @@ macroexpand (struct cpp_reader *pfile, struct definition *defn) if (nargs >= 0) { - enum cpp_token token; /* { dg-bogus "token" "uninitialized variable warning" { xfail *-*-* } } */ + enum cpp_token token; /* { dg-bogus "token" "uninitialized variable warning" } */ int i, rest_args; i = 0; rest_args = 0; diff --git a/gcc/testsuite/gcc.dg/uninit-3.c b/gcc/testsuite/gcc.dg/uninit-3.c index 78c4254dea5..ac5bfec8e72 100644 --- a/gcc/testsuite/gcc.dg/uninit-3.c +++ b/gcc/testsuite/gcc.dg/uninit-3.c @@ -8,7 +8,7 @@ extern void error (char *); int parse_charconst (const char *start, const char *end) { - int c; /* { dg-bogus "c" "uninitialized variable warning" { xfail *-*-* } } */ + int c; /* { dg-bogus "c" "uninitialized variable warning" } */ int nchars, retval; nchars = 0; diff --git a/gcc/testsuite/gcc.dg/uninit-4.c b/gcc/testsuite/gcc.dg/uninit-4.c index a27317ebed5..c51d00802b7 100644 --- a/gcc/testsuite/gcc.dg/uninit-4.c +++ b/gcc/testsuite/gcc.dg/uninit-4.c @@ -23,7 +23,7 @@ extern struct operation cpp_lex (void); void cpp_parse_expr (void) { - int rprio; /* { dg-bogus "rprio" "uninitialized variable warning" { xfail *-*-* } } */ + int rprio; /* { dg-bogus "rprio" "uninitialized variable warning" } */ struct operation op; for (;;) diff --git a/gcc/testsuite/gcc.dg/uninit-5.c b/gcc/testsuite/gcc.dg/uninit-5.c index ac760d69e03..ae7a8de7646 100644 --- a/gcc/testsuite/gcc.dg/uninit-5.c +++ b/gcc/testsuite/gcc.dg/uninit-5.c @@ -1,5 +1,4 @@ -/* Spurious uninitialized-variable warnings. - These cases are documented as not working in the gcc manual. */ +/* Spurious uninitialized-variable warnings. */ /* { dg-do compile } */ /* { dg-options "-O -Wuninitialized" } */ @@ -10,7 +9,7 @@ extern void foo(void); void func1(int cond) { - int x; /* { dg-bogus "x" "uninitialized variable warning" { xfail *-*-* } } */ + int x; /* { dg-bogus "x" "uninitialized variable warning" } */ if(cond) x = 1; @@ -24,7 +23,7 @@ func1(int cond) void func2 (int cond) { - int x; /* { dg-bogus "x" "uninitialized variable warning" { xfail *-*-* } } */ + int x; /* { dg-bogus "x" "uninitialized variable warning" } */ int flag = 0; if(cond) diff --git a/gcc/testsuite/gcc.dg/uninit-6.c b/gcc/testsuite/gcc.dg/uninit-6.c index 2c428df79b6..b0f2083ab4b 100644 --- a/gcc/testsuite/gcc.dg/uninit-6.c +++ b/gcc/testsuite/gcc.dg/uninit-6.c @@ -34,12 +34,12 @@ struct tree * make_something(int a, int b, int c) { struct tree *rv; - struct tree *field; /* { dg-bogus "field" "uninitialized variable warning" { xfail *-*-* } } */ + struct tree *field; rv = malloc (sizeof (struct tree)); rv->car = 0; - APPEND(rv, field, INTEGER_T, a); + APPEND(rv, field, INTEGER_T, a); /* { dg-bogus "field" "uninitialized variable warning" { xfail *-*-* } } */ APPEND(rv, field, PTR_T, b); APPEND(rv, field, INTEGER_T, c); diff --git a/gcc/testsuite/gcc.dg/uninit-8.c b/gcc/testsuite/gcc.dg/uninit-8.c index 94117da37c9..98700f4aa1f 100644 --- a/gcc/testsuite/gcc.dg/uninit-8.c +++ b/gcc/testsuite/gcc.dg/uninit-8.c @@ -11,7 +11,7 @@ void add_bignums (int *out, int *x, int *y) { int p, sum; - int carry; /* { dg-bogus "carry" "uninitialized variable warning" { xfail *-*-* } } */ + int carry; /* { dg-bogus "carry" "uninitialized variable warning" } */ p = 0; for (; *x; x++, y++, out++, p++) diff --git a/gcc/testsuite/gcc.dg/uninit-9.c b/gcc/testsuite/gcc.dg/uninit-9.c index 62681f9e0fd..2a8ccb69f32 100644 --- a/gcc/testsuite/gcc.dg/uninit-9.c +++ b/gcc/testsuite/gcc.dg/uninit-9.c @@ -23,7 +23,7 @@ func(struct foo *list, int count) { int n_clobbers = 0; int i; - struct foo **clob_list; /* { dg-bogus "clob_list" "uninitialized variable warning" { xfail *-*-* } } */ + struct foo **clob_list; /* { dg-bogus "clob_list" "uninitialized variable warning" } */ if(list[0].type == PARALLEL) { diff --git a/gcc/testsuite/gcc.dg/uninit-H.c b/gcc/testsuite/gcc.dg/uninit-H.c new file mode 100644 index 00000000000..30f58308886 --- /dev/null +++ b/gcc/testsuite/gcc.dg/uninit-H.c @@ -0,0 +1,19 @@ +/* PR 14204 */ +/* { dg-do compile } */ +/* { dg-options "-O -Wall -Werror" } */ + +#if defined __alpha__ +# define ASM __asm__("$30") +#elif defined __i386__ +# define ASM __asm__("esp") +#elif defined __powerpc__ +# define ASM __asm__("r1") +#else +# define ASM +#endif + +void *load_PCB (void) +{ + register void *sp ASM; + return sp; /* { dg-bogus "uninitialized" } */ +} diff --git a/gcc/testsuite/gcc.dg/warn-1.c b/gcc/testsuite/gcc.dg/warn-1.c index 9d0080171d2..ce35b41e941 100644 --- a/gcc/testsuite/gcc.dg/warn-1.c +++ b/gcc/testsuite/gcc.dg/warn-1.c @@ -5,12 +5,12 @@ static void foo (p) int p; -{ /* { dg-warning "passing arg 1 of" } */ +{ } void bar (void) { void *vp; - foo (vp); /* { dg-warning "" } */ + foo (vp); /* { dg-warning "passing arg 1 of" } */ } diff --git a/gcc/testsuite/gfortran.fortran-torture/ChangeLog.g95 b/gcc/testsuite/gfortran.fortran-torture/ChangeLog.g95 new file mode 100644 index 00000000000..c333a3eab1a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/ChangeLog.g95 @@ -0,0 +1,99 @@ +2003-07-24 Lifang Zeng <zlf605@hotmail.com> + + * execute/where_3.f90: Modified. + * execute/where_6.f90: New testcase. + +2003-07-09 Chun HUang <compiler@sohu.com> + + * execute/intrinsic_scan.f90: Test the SCAN intrinsic. + * execute/intrinsic_verify.f90: Test the VERIFY intrinsic. + +2003-07-02 Paul Brook <paul@nowt.org> + + * execite/initializer.f90: Test arrays with scalar initializer. + +2003-06-02 Kejia Zhao <kejia_zh@yahoo.com.cn> + + * execute/intrinsic_associated.f90: New testcase. + * execute/intrinsic_associated_2.f90: New testcase. + +2003-06-01 Paul Brook <paul@nowt.org> + + * execute/power.f90: Check complex ** real. + +2003-05-20 Paul Brook <paul@nowt.org> + + * execute/forall_1.f90: Avoid many to one assignment. + +2003-05-20 Canqun Yang <canqun@yahoo.com.cn> + + * execute/forall_1.f90: Replace logical operator 'and' with 'or'. + +2003-05-19 Lifang Zeng <zlf605@hotmail.com> + + * execute/forall_1.f90: FORALL with negative stride, FORALL has + arbitrary number of indexes, and actual variables used as FORALL + indexes. + +2003-05-07 Kejia Zhao <kejia_zh@yahoo.com.cn> + + * execute/der_point.f90: DERIVED type with components point to the + DERIVED type itself, and two DERIVED type with components point to + each other. + +2003-03-16 Paul Brook <paul@nowt.org> + + * execute/arrayarg.f90: Assumed shape dummy arrays aren't legal when + using an implicit interface. + * execute/arraysave.f90: Ditto. + * execute/bounds.f90: Ditto. + * lib/f95-torture.exp (TORTURE_OPTIONS): Check f77 arrays. + +2003-03-15 Paul Brook <paul@nowt.org> + + * execute/elemental.f90: Test expressions inside elemental functions. + +2003-03-14 Paul Brook <paul@nowt.org> + + * lib/f95-torture.exp (TORTURE_OPTIONS): Check different array + repacking strategies. + +2003-02-15 Paul Brook <paul@nowt.org> + + * execute/der_init.f90: Add tests for non-constant constructors. + +2003-02-08 Paul Brook <paul@nowt.org> + + * execute/constructor.f90: Additional tests for non-constant + constructors with unexpanded implicit do loops. + +2003-02-06 Paul Brook <paul@nowt.org> + + * execute/der_type.f90: Add extra tests for initializers and passing + components as arguments. + +2003-02-01 Paul Brook <paul@nowr.org> + + * execute/elemental.f90: Test intrinsic elemental conversion + routines. + +2003-01-28 Paul Brook <paul@nowt.org> + + * compile/mystery_proc.f90: New testcase. + +2003-01-27 Paul Brook <paul@nowt.org> + + * execute/intrinsic_minmax.f90: Add a couple more variations. + +2003-01-26 Paul Brook <paul@nowt.org> + + * execute/contained.f90: New testcase. + * execute/intrinsic_present.f90: New testcase. + +2003-01-22 Steven Bosscher <s.bosscher@student.tudelft.nl> + + * compile/bergervoet2.f90, compile/ambig.f90, + compile/actual.f90, execute/integer_select.f90: + New testcases. + * execute/function_module_1.f90: Fix syntax error. + * execute/retarray.f90: Fix another syntax error. diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 new file mode 100644 index 00000000000..871c0814900 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 @@ -0,0 +1,38 @@ +module modull + +contains + +function fun( a ) + real, intent(in) :: a + real :: fun + fun = a +end function fun + +end module modull + + + +program t5 + +use modull + +real :: a, b + +b = foo( fun, a ) + +contains + +function foo( f, a ) + real, intent(in) :: a + interface + function f( x ) + real, intent(in) :: x + real :: f + end function f + end interface + real :: foo + + foo = f( a ) +end function foo + +end program t5 diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 new file mode 100644 index 00000000000..f5cce41f71e --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 @@ -0,0 +1,26 @@ +! Snippet to test various allocate statements + +program test_allocate + implicit none + type t + integer i + real r + end type + type pt + integer, pointer :: p + end type + integer, allocatable, dimension(:, :) :: a + type (t), pointer, dimension(:) :: b + type (pt), pointer :: c + integer, pointer:: p + integer n + + n = 10 + allocate (a(1:10, 4)) + allocate (a(5:n, n:14)) + allocate (a(6, 8)) + allocate (b(n)) + allocate (c) + allocate (c%p) + allocate (p) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 new file mode 100644 index 00000000000..3e5e07dadb0 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 @@ -0,0 +1,26 @@ +MODULE TYPESP + TYPE DMT + REAL(KIND(1.D0)), POINTER :: ASPK(:) + END TYPE DMT +END MODULE TYPESP + +MODULE TCNST + Integer, Parameter :: DIM_TEMP_BUFFER=10000 + Real(Kind(1.d0)), Parameter :: COLROW_=0.33,PERCENT=0.7 +end MODULE TCNST + + +Subroutine DOWORK(A) + Use TYPESP + Use TCNST + Type(DMT), intent (inout) :: A + Real(Kind(1.d0)),Pointer :: ASPK(:) + Integer :: ISIZE, IDIM + + ISIZE=DIM_TEMP_BUFFER + + Allocate(ASPK(ISIZE),STAT=INFO) + IDIM = MIN(ISIZE,SIZE(A%ASPK)) + ASPK(1:IDIM) = A%ASPK(1:IDIM) + Return +End Subroutine DOWORK diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 new file mode 100644 index 00000000000..1eec0bb59ce --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 @@ -0,0 +1,12 @@ +! Program to test array IO. Should print the numbers 1-20 in order +program arrayio + implicit none + integer, dimension(5, 4) :: a + integer i, j + + do j=1,4 + a(:, j) = (/ (i + (j - 1) * 5, i=1,5) /) + end do + + write (*) a +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 new file mode 100644 index 00000000000..eef33e425c2 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 @@ -0,0 +1,5 @@ + function testi() result(res) + integer :: res + res = 0 + end function testi + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp b/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp new file mode 100644 index 00000000000..81e1c1cebee --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp @@ -0,0 +1,55 @@ +# Expect driver script for GCC Regression Tests +# Copyright (C) 2003 Free Software Foundation +# +# This file 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# These tests come from many different contributors. + +if $tracelevel then { + strace $tracelevel +} + +# load support procs +load_lib fortran-torture.exp + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture $testcase +} + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 new file mode 100644 index 00000000000..60f31092e73 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 @@ -0,0 +1,15 @@ +! Obscure failure that disappeared when the parameter was removed. +! Works OK now. +module mymod +implicit none +contains + subroutine test(i) + implicit none + integer i + end subroutine +end module mymod + +program error + use mymod +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 new file mode 100644 index 00000000000..76ef6c62871 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 @@ -0,0 +1,11 @@ +! Arrays declared in parent but used in the child. +program error + implicit none + integer, dimension (10) :: a +contains + subroutine test() + implicit none + a(1) = 0 + end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 new file mode 100644 index 00000000000..da5e8475c54 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 @@ -0,0 +1,12 @@ +! Program to check using parent variables in more than one contained function +program contained_3 + implicit none + integer var +contains + subroutine one + var = 1 + end subroutine + subroutine two + var = 2 + end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 new file mode 100644 index 00000000000..233dab878fd --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 @@ -0,0 +1,35 @@ +! Check contained functions with the same name. +module contained_4 + +contains + + subroutine foo1() + call bar() + contains + subroutine bar() + end subroutine bar + end subroutine foo1 + + subroutine foo2() + call bar() + contains + subroutine bar() + end subroutine bar + end subroutine foo2 + +end module contained_4 + +subroutine foo1() +call bar() +contains + subroutine bar() + end subroutine bar +end subroutine + +subroutine foo2() + call bar() +contains + subroutine bar() + end subroutine bar +end subroutine foo2 + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 new file mode 100644 index 00000000000..94946f76b0d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 @@ -0,0 +1,10 @@ +! Function returning an array continaed in a module. Caused problems 'cos +! we tried to add the dummy return vars to the parent scope. + +Module contained_5 +contains +FUNCTION test () + REAL, DIMENSION (1) :: test + test(1)=0.0 +END FUNCTION +end module diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 new file mode 100644 index 00000000000..777cd132c85 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 @@ -0,0 +1,37 @@ +! Program to test conversion. Does not actualy test the generated code +program convert + implicit none + integer(kind=4) i + integer(kind=8) m + real(kind=4) r + real(kind=8) q + complex(kind=4) c + complex(kind=8) z + + ! each of these should generate a single intrinsic conversion expression + i = int(i) + i = int(m) + i = int(r) + i = int(q) + i = int(c) + i = int(z) + m = int(i, kind=8) + m = int(m, kind=8) + m = int(r, kind=8) + m = int(q, kind=8) + m = int(c, kind=8) + m = int(z, kind=8) + r = real(i) + r = real(m) + r = real(r) + r = real(q) + r = real(c) + r = real(z, kind=4) + q = real(i, kind=8) + q = real(m, kind=8) + q = real(r, kind=8) + q = real(q, kind=8) + q = real(c, kind=8) + ! Note real(<complex>) returns the type kind of the argument. + q = real(z) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 new file mode 100644 index 00000000000..d54f64899f3 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 @@ -0,0 +1,13 @@ +! Program to test array valued dummy functions +SUBROUTINE dummyfn(deriv) + implicit none + INTERFACE + FUNCTION deriv() + REAL :: deriv(4) + END FUNCTION deriv + END INTERFACE + + REAL :: dx(4) + + dx = deriv() +END SUBROUTINE diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 new file mode 100644 index 00000000000..bd12d502ef8 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 @@ -0,0 +1,42 @@ +! Program to test empty IF statements +program emptyif + implicit none + logical c + logical d + + if (c) then + c = .true. + end if + + if (c) then + else + c = .true. + end if + + if (c) then + c = .true. + else + end if + + if (c) then + c = .true. + elseif (d) then + c = .true. + else + end if + + if (c) then + c = .true. + elseif (d) then + else + c = .true. + end if + + if (c) then + elseif (d) then + c = .true. + else + c = .true. + end if + +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 new file mode 100644 index 00000000000..fab9aa665a4 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 @@ -0,0 +1,5 @@ +! Explicit function rsult variables +function fnresvar() result (r) + integer r + r = 0 +end function diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 new file mode 100644 index 00000000000..eb493411b34 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 @@ -0,0 +1,19 @@ +! Program to test generic interfaces. +program gen_interf + implicit none + interface gen + function ifn (a) + integer :: a, ifn + end function + end interface + interface gsub + subroutine igsub (a) + integer a + end subroutine + end interface + + integer i + + call gsub (i) + i = gen(i) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 new file mode 100644 index 00000000000..296821e8983 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 @@ -0,0 +1,8 @@ +implicit integer(a), logical(b-c), real(d-y), integer(z) +a = 1_4 +b = .true. +c = b +d = 1.0e2 +y = d +z = a +end diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 new file mode 100644 index 00000000000..f67ae57ae8e --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 @@ -0,0 +1,9 @@ +! Check we can cope with end labels in IO statements +program m + implicit none + integer i + do while (.true.) + read(*, *, end = 1) i + end do +1 continue +end program m diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 new file mode 100644 index 00000000000..f727881d75b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 @@ -0,0 +1,10 @@ +! We were incorrectly trying to create a variable for the common block itself, +! in addition to the variables it contains. +module FOO + implicit none + integer I + common /C/I +contains + subroutine BAR + end subroutine BAR +end module FOO diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 new file mode 100644 index 00000000000..a1ca83a9a21 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 @@ -0,0 +1,18 @@ +! This uncovered a bug in the reading/writing of expressions. +module module_expr_1 + integer a +end module + +module module_expr_2 + use module_expr_1 +contains + +subroutine myproc (p) + integer, dimension (a) :: p +end subroutine +end module + +program module_expr + use module_expr_1 + use module_expr_2 +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 new file mode 100644 index 00000000000..17386d4b8e0 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 @@ -0,0 +1,14 @@ +! Check module procedures with arguments +module module_proc +contains +subroutine s(p) + integer p +end subroutine +end module + +program test +use module_proc +integer i +call s(i) +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 new file mode 100644 index 00000000000..105073596f5 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 @@ -0,0 +1,9 @@ +! Result variables in module procedures +module module_result + implicit none +contains +function test () result (res) + integer res + res = 0 +end function +end module diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 new file mode 100644 index 00000000000..1e0b4a6733c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 @@ -0,0 +1,6 @@ +! This caused problems because we created a symbol for P while +! trying to parse the argument list as a substring reference. +program named_args + implicit none + integer, parameter :: realdp = selected_real_kind(p=8,r=30) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 new file mode 100644 index 00000000000..8921bcddcad --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 @@ -0,0 +1,7 @@ +! legal +integer, parameter :: j = huge(j) +integer i + + if (j /= huge(i)) call abort +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 new file mode 100644 index 00000000000..e480751f19d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 @@ -0,0 +1,23 @@ +! Program to test initialization expressions involving subobjects +program parameter_2 + implicit none + type :: SS + integer :: I + integer :: J + end type SS + type :: TT + integer :: N + type (SS), dimension(2) :: o + end type + + type (SS), parameter :: s = SS (1, 2) + type (TT), parameter :: t = TT(42, (/ SS(3, 4), SS(8, 9) /)) + + integer, parameter :: a(2) = (/5, 10/) + integer, parameter :: d1 = s%i + integer, parameter :: d2 = a(2) + integer, parameter :: d4 = t%o(2)%j + + integer q1, q2, q3, q4 + common /c1/q1(d1), q2(d2), q3(a(1)), q4(d4) ! legal +end diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 new file mode 100644 index 00000000000..a8e632b1f4b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 @@ -0,0 +1,8 @@ +! This checks that the shape of the SHAPE intrinsic is known. +PROGRAM shape_reshape + INTEGER, ALLOCATABLE :: I(:,:) + ALLOCATE(I(2,2)) + I = RESHAPE((/1,2,3,4/),SHAPE=SHAPE(I)) + DEALLOCATE(I) +END PROGRAM + diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 new file mode 100644 index 00000000000..9a936f09c3d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 @@ -0,0 +1,10 @@ +! Program to check the STOP and PAUSE intrinsics +program stoppause + + pause + pause 1 + pause 'Hello world' + stop + stop 42 + stop 'Go away' +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 new file mode 100644 index 00000000000..9625b10fed2 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 @@ -0,0 +1,6 @@ +! Check known length string parameters +subroutine test (s) + character(len=80) :: s + + s = "Hello World" +end subroutine diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 new file mode 100644 index 00000000000..50b83cc6a12 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 @@ -0,0 +1,5 @@ +! Program to test simple IO +program testwrite + write (*) 1 + write (*) "Hello World" +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/a_edit_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/a_edit_1.f90 new file mode 100644 index 00000000000..55a6f3cdf2c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/a_edit_1.f90 @@ -0,0 +1,17 @@ +! pr 15113 +! Ax edit descriptor x larger than destination +! A edit descriptor with no field width segfaults + character*16 C + character*4 D + data C / 'ABCDEFGHIJKLMNOP'/ + read(C,'(A7)')D + if (D.NE.'DEFG') then +! print*,D + call abort + endif + read(C,'(A)')D + if (D.NE.'ABCD') then +! print*,D + call abort + endif + end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/allocate.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/allocate.f90 new file mode 100644 index 00000000000..61f717da7bc --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/allocate.f90 @@ -0,0 +1,38 @@ +! Test allocation and deallocation. +program test_allocate + call t1 (.true.) + call t1 (.false.) + call t2 +contains + +! Implicit deallocation and saved aloocated variables. +subroutine t1(first) + real, allocatable, save :: p(:) + real, allocatable :: q(:) + logical first + + if (first) then + if (allocated (p)) call abort () + else + if (.not. allocated (p)) call abort () + end if + if (allocated (q)) call abort () + + if (first) then + allocate (p(5)) + else + deallocate (p) + end if + allocate (q(5)) +end subroutine + +! Explicit deallocation. +subroutine t2() + real, allocatable :: r(:) + + allocate (r(5)) + pr = 1.0 + deallocate (r) + if (allocated(r)) call abort () +end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/alternate_return.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/alternate_return.f90 new file mode 100644 index 00000000000..5c77844e6da --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/alternate_return.f90 @@ -0,0 +1,18 @@ +program alt_return + implicit none + + call myproc (1, *10, 42) +20 continue + call abort () +10 continue + call myproc(2, *20, 42) + call myproc(3, *20, 42) +contains +subroutine myproc(n, *, i) + integer n, i + if (i .ne. 42) call abort () + if (n .eq. 1) return 1 + if (n .eq. 2) return +end subroutine +end program alt_return + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/args.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/args.f90 new file mode 100644 index 00000000000..263c795ed70 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/args.f90 @@ -0,0 +1,22 @@ +! Program to test procudure args +subroutine test (a, b) + integer, intent (IN) :: a + integer, intent (OUT) :: b + + if (a .ne. 42) call abort + b = 43 +end subroutine + +program args + implicit none + external test + integer i, j + + i = 42 + j = 0 + CALL test (i, j) + if (i .ne. 42) call abort + if (j .ne. 43) call abort + i = 41 + CALL test (i + 1, j) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/arithmeticif.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/arithmeticif.f90 new file mode 100644 index 00000000000..d06167e6814 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/arithmeticif.f90 @@ -0,0 +1,25 @@ +! Program to test the arithmetic if statement +function testif (a) + implicit none + integer a, b, testif + + if (a) 1, 2, 3 + b = 2 + goto 4 + 1 b = -1 + goto 4 + 2 b = 0 + goto 4 + 3 b = 1 + 4 testif = b +end function + +program testwrite + implicit none + integer i + integer testif + + if (testif (-10) .ne. -1) call abort + if (testif (0) .ne. 0) call abort + if (testif (10) .ne. 1) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg.f90 new file mode 100644 index 00000000000..b588d050b69 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg.f90 @@ -0,0 +1,145 @@ +! Program to test arrays +! The program outputs a series of numbers. +! Two digit numbers beginning with 0, 1, 2 or 3 is a normal. +! Three digit numbers starting with 4 indicate an error. +! Using 1D arrays isn't a sufficient test, the first dimension is often +! handled specially. + +! Fixed size parameter +subroutine f1 (a) + implicit none + integer, dimension (5, 8) :: a + + if (a(1, 1) .ne. 42) call abort + + if (a(5, 8) .ne. 43) call abort +end subroutine + + +program testprog + implicit none + integer, dimension(3:7, 4:11) :: a + a(:,:) = 0 + a(3, 4) = 42 + a(7, 11) = 43 + call test(a) +contains +subroutine test (parm) + implicit none + ! parameter + integer, dimension(2:, 3:) :: parm + ! Known size arry + integer, dimension(5, 8) :: a + ! Known size array with different bounds + integer, dimension(4:8, 3:10) :: b + ! Unknown size arrays + integer, dimension(:, :), allocatable :: c, d, e + ! Vectors + integer, dimension(5) :: v1 + integer, dimension(10, 10) :: v2 + integer n + external f1 + + ! Same size + allocate (c(5,8)) + ! Same size, different bounds + allocate (d(11:15, 12:19)) + ! A larger array + allocate (e(15, 24)) + a(:,:) = 0 + b(:,:) = 0 + c(:,:) = 0 + d(:,:) = 0 + a(1,1) = 42 + b(4, 3) = 42 + c(1,1) = 42 + d(11,12) = 42 + a(5, 8) = 43 + b(8, 10) = 43 + c(5, 8) = 43 + d(15, 19) = 43 + + v2(:, :) = 0 + do n=1,5 + v1(n) = n + end do + + v2 (3, 1::2) = v1 (5:1:-1) + v1 = v1 + 1 + + if (v1(1) .ne. 2) call abort + if (v2(3, 3) .ne. 4) call abort + + ! Passing whole arrays + call f1 (a) + call f1 (b) + call f1 (c) + call f2 (a) + call f2 (b) + call f2 (c) + ! passing expressions + a(1,1) = 41 + a(5,8) = 42 + call f1(a+1) + call f2(a+1) + a(1,1) = 42 + a(5,8) = 43 + call f1 ((a + b) / 2) + call f2 ((a + b) / 2) + ! Passing whole arrays as sections + call f1 (a(:,:)) + call f1 (b(:,:)) + call f1 (c(:,:)) + call f2 (a(:,:)) + call f2 (b(:,:)) + call f2 (c(:,:)) + ! Passing sections + e(:,:) = 0 + e(2, 3) = 42 + e(6, 10) = 43 + n = 3 + call f1 (e(2:6, n:10)) + call f2 (e(2:6, n:10)) + ! Vector subscripts + ! v1= index plus one, v2(3, ::2) = reverse of index + e(:,:) = 0 + e(2, 3) = 42 + e(6, 10) = 43 + call f1 (e(v1, n:10)) + call f2 (e(v1, n:10)) + ! Double vector subscript + e(:,:) = 0 + e(6, 3) = 42 + e(2, 10) = 43 + !These are not resolved properly + call f1 (e(v1(v2(3, ::2)), n:10)) + call f2 (e(v1(v2(3, ::2)), n:10)) + ! non-contiguous sections + e(:,:) = 0 + e(1, 1) = 42 + e(13, 22) = 43 + n = 3 + call f1 (e(1:15:3, 1:24:3)) + call f2 (e(::3, ::n)) + ! non-contiguous sections with bounds + e(:,:) = 0 + e(3, 4) = 42 + e(11, 18) = 43 + n = 19 + call f1 (e(3:11:2, 4:n:2)) + call f2 (e(3:11:2, 4:n:2)) + + ! Passing a dummy variable + call f1 (parm) + call f2 (parm) +end subroutine +! Assumed shape parameter +subroutine f2 (a) + integer, dimension (1:, 1:) :: a + + if (a(1, 1) .ne. 42) call abort + + if (a(5, 8) .ne. 43) call abort +end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg2.f90 new file mode 100644 index 00000000000..9cb5b613d64 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg2.f90 @@ -0,0 +1,21 @@ +! Program to test array arguments which depend on other array arguments +program arrayarg2 + integer, dimension(5) :: a, b + + a = (/1, 2, 3, 4, 5/) + b = (/2, 3, 4, 5, 6/) + + call test (a, b) + + if (any (b .ne. (/4, 7, 10, 13, 16/))) call abort +contains +subroutine test (x1, x2) + implicit none + integer, dimension(1:), intent(in) :: x1 + integer, dimension(1:), intent(inout) :: x2 + integer, dimension(1:size(x1)) :: x3 + + x3 = x1 * 2 + x2 = x2 + x3 +end subroutine test +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/arraysave.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/arraysave.f90 new file mode 100644 index 00000000000..94b234bd512 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/arraysave.f90 @@ -0,0 +1,24 @@ +! Program to test arrays with the save attribute +program testarray + implicit none + integer, save, dimension (6, 5) :: a, b + + a = 0 + a(1, 1) = 42 + a(6, 5) = 43 + b(:,1:5) = a + + call fn (a) +contains +subroutine fn (a) + implicit none + integer, dimension(1:, 1:) :: a + integer, dimension(2) :: b + + b = ubound (a) + if (any (b .ne. (/6, 5/))) call abort + if (a(1, 1) .ne. 42) call abort + if (a(6, 5) .ne. 43) call abort +end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/assumed_size.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/assumed_size.f90 new file mode 100644 index 00000000000..b2c4657c647 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/assumed_size.f90 @@ -0,0 +1,39 @@ +! Program to test assumed size arrays +subroutine test2(p) + integer, dimension(2, *) :: p + + if (any (p(:, 1:3) .ne. reshape((/1, 2, 4, 5, 7, 8/), (/2, 3/)))) & + call abort () +end subroutine + +program assumed_size + integer, dimension (3, 3) :: a + external test2 + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + + call test1(a, (/1, 2, 3, 4, 5, 6/)) + if (a(1,1) .ne. 0) call abort + a(1, 1) = 1 + call test1(a(1:2, :), (/1, 2, 4, 5, 7, 8/)) + if (a(1,1) .ne. 0) call abort + a(1, 1) = 1 + call test1(a(3:1:-1, :), (/3, 2, 1, 6, 5, 4/)) + if (a(3,1) .ne. 0) call abort + a(3, 1) = 3 + call test1(a(:, 2:3), (/4, 5, 6, 7, 8, 9/)) + if (a(1, 2) .ne. 0) call abort + a(1, 2) = 4 + + call test2(a(1:2, :)) + call test2((/1, 2, 4, 5, 7, 8/)) +contains +subroutine test1(p, q) + integer, dimension(*) :: p + integer, dimension(1:) :: q + + if (any (p(1:size(q)) .ne. q)) call abort () + p(1) = 0 +end subroutine + +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/bounds.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/bounds.f90 new file mode 100644 index 00000000000..b1ad840738c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/bounds.f90 @@ -0,0 +1,35 @@ +! Program to test the upper and lower bound intrinsics +program testbounds + implicit none + real, dimension(:, :), allocatable :: a + integer, dimension(5) :: j + integer i + + allocate (a(3:8, 6:7)) + + ! With one parameter + j = 0; + j(3:4) = ubound(a) + if (j(3) .ne. 8) call abort + if (j(4) .ne. 7) call abort + + ! With two parameters, assigning to an array + j = lbound(a, 1) + if ((j(1) .ne. 3) .or. (j(5) .ne. 3)) call abort + + ! With a variable second parameter + i = 2 + i = lbound(a, i) + if (i .ne. 6) call abort + + call test(a) +contains +subroutine test (a) + real, dimension (1:, 1:) :: a + integer i + + i = 2 + if ((ubound(a, 1) .ne. 6) .or. (ubound(a, i) .ne. 2)) call abort +end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/character_select_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/character_select_1.f90 new file mode 100644 index 00000000000..c42cea4fc21 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/character_select_1.f90 @@ -0,0 +1,12 @@ +CHARACTER(LEN=6) :: C = "STEVEN" + +SELECT CASE (C) + CASE ("AAA":"EEE") + CALL abort + CASE ("R":"T") + CONTINUE + CASE DEFAULT + CALL abort +END SELECT +END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/cmplx.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/cmplx.f90 new file mode 100644 index 00000000000..8e434c03342 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/cmplx.f90 @@ -0,0 +1,45 @@ +! Test complex munbers +program testcmplx + implicit none + complex(kind=4) c, d + complex(kind=8) z + real(kind=4) x, y + real(kind=8) q + + ! cmplx intrinsic + x = 3 + y = 4 + c = cmplx(x,y) + if (c .ne. (3.0, 4.0)) call abort + x = 4 + y = 3 + z = cmplx(x, y, 8) + if (z .ne. (4.0, 3.0)) call abort + z = c + if (z .ne. (3.0, 4.0)) call abort + + ! dcmplx intrinsic + x = 3 + y = 4 + z = dcmplx (x, y) + if (z .ne. (3.0, 4.0)) call abort + + ! conjucates and aimag + c = (1.0, 2.0) + c = conjg (c) + x = aimag (c) + if (abs (c - (1.0, -2.0)) .gt. 0.001) call abort + if (x .ne. -2.0) call abort + z = (2.0, 1.0) + z = conjg (z) + q = aimag (z) + if (z .ne. (2.0, -1.0)) call abort + if (q .ne. -1.0) call abort + + ! addition, subtraction and multiplication + c = (1, 3) + d = (5, 2) + if (c + d .ne. ( 6, 5)) call abort + if (c - d .ne. (-4, 1)) call abort + if (c * d .ne. (-1, 17)) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/common.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/common.f90 new file mode 100644 index 00000000000..2ea1788eb54 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/common.f90 @@ -0,0 +1,53 @@ +! Program to test COMMON and EQUIVALENCE. +program common + real (kind=8) a(8) + real (kind=8) b(5), c(5) + common /com1/b,c + equivalence (a(1), b(2)) + b = 100 + c = 200 + call common_pass + call common_par (a, b,c) + call global_equiv + call local_equiv +end + +! Use common block to pass values +subroutine common_pass + real (kind=8) a(8) + real (kind=8) b(5), c(5) + common /com1/b,c + equivalence (a(1), b(2)) + if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort +end subroutine + +! Common variables as argument +subroutine common_par (a, b, c) + real (kind=8) a(8), b(5), c(5) + if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort + if (any (b .ne. (/100,100,100,100,100/))) call abort + if (any (c .ne. (/200,200,200,200,200/))) call abort +end subroutine + +! Global equivalence +subroutine global_equiv + real (kind=8) a(8), b(5), c(5), x(8), y(4), z(4) + common /com2/b, c, y, z + equivalence (a(1), b(2)) + equivalence (x(4), y(1)) + b = 100 + c = 200 + y = 300 + z = 400 + if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort + if (any (x .ne. (/200,200,200,300,300,300,300,400/))) call abort +end + +! Local equivalence +subroutine local_equiv + real (kind=8) a(8), b(10) + equivalence (a(1), b(3)) + b(1:5) = 100 + b(6:10) = 200 + if (any (a .ne. (/100,100,100,200,200,200,200,200/))) call abort +end subroutine diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/common_size.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/common_size.f90 new file mode 100644 index 00000000000..936c41e3282 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/common_size.f90 @@ -0,0 +1,10 @@ +! The size of common 'com1' should be 80, instead of 112. +program common_size + real (kind=8) a(8) + real (kind=8) b(5), c(5) + common /com1/b,c + equivalence (a(1), b(2)) + b = 100 + c = 200 + if ((a (4) .ne. 100) .or. (a(5) .ne. 200)) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/constructor.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/constructor.f90 new file mode 100644 index 00000000000..96cb89d721c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/constructor.f90 @@ -0,0 +1,29 @@ +! Program to test array constructors +program constructors + integer, dimension (4) :: a + integer, dimension (3, 2) :: b + integer i, j, k, l, m, n + + a = (/1, (i,i=2,4)/) + do i = 1, 4 + if (a(i) .ne. i) call abort + end do + + b = reshape ((/0, 1, 2, 3, 4, 5/), (/3, 2/)) + 1 + do i=1,3 + if (b(i, 1) .ne. i) call abort + if (b(i, 2) .ne. i + 3) call abort + end do + + k = 1 + l = 2 + m = 3 + n = 4 + ! The remainder assumes constant constructors work ok. + a = (/n, m, l, k/) + if (any (a .ne. (/4, 3, 2, 1/))) call abort + a = (/((/i+10, 42/), i = k, l)/) + if (any (a .ne. (/11, 42, 12, 42/))) call abort + a = (/(I, I=k,l) , (J, J=m,n)/) + if (any (a .ne. (/1, 2, 3, 4/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/contained.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/contained.f90 new file mode 100644 index 00000000000..3c7117744dd --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/contained.f90 @@ -0,0 +1,16 @@ +program contained + implicit none + integer i + + i = 0; + call testproc (40) + if (i .ne. 42) call abort +contains + subroutine testproc (p) + implicit none + integer p + + if (p .ne. 40) call abort + i = p + 2 + end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/contained2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/contained2.f90 new file mode 100644 index 00000000000..cae94b704e1 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/contained2.f90 @@ -0,0 +1,28 @@ +! Program to check resolution of symbols with the same name +program contained2 + implicit none + integer var1 + + var1 = 42 + if (f1() .ne. 1) call abort + call f2() + if (var1 .ne. 42) call abort +contains + +function f1 () + implicit none + integer f1 + integer var1 + integer f2 + + var1 = 1 + f2 = var1 + f1 = f2 +end function + +subroutine f2() + implicit none + if (f1() .ne. 1) call abort +end subroutine + +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/csqrt_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/csqrt_1.f90 new file mode 100644 index 00000000000..680449f3ede --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/csqrt_1.f90 @@ -0,0 +1,78 @@ +! PR 14396 +! These we failing on targets which do not provide the c99 complex math +! functions. +! Extracted from intrinsic77.f in the g77 testsuite. + logical fail + common /flags/ fail + fail = .false. + call square_root + if (fail) call abort + end + subroutine square_root + intrinsic sqrt, dsqrt, csqrt + real x, a + x = 4.0 + a = 2.0 + call c_r(SQRT(x),a,'SQRT(real)') + call c_d(SQRT(1.d0*x),1.d0*a,'SQRT(double)') + call c_c(SQRT((1.,0.)*x),(1.,0.)*a,'SQRT(complex)') + call c_d(DSQRT(1.d0*x),1.d0*a,'DSQRT(double)') + call c_c(CSQRT((1.,0.)*x),(1.,0.)*a,'CSQRT(complex)') + call p_r_r(SQRT,x,a,'SQRT') + call p_d_d(DSQRT,1.d0*x,1.d0*a,'DSQRT') + call p_c_c(CSQRT,(1.,0.)*x,(1.,0.)*a ,'CSQRT') + end + subroutine failure(label) +! Report failure and set flag + character*(*) label + logical fail + common /flags/ fail + write(6,'(a,a,a)') 'Test ',label,' FAILED' + fail = .true. + end + subroutine c_r(a,b,label) +! Check if REAL a equals b, and fail otherwise + real a, b + character*(*) label + if ( abs(a-b) .gt. 1.0e-5 ) then + call failure(label) + write(6,*) 'Got ',a,' expected ', b + end if + end + subroutine c_d(a,b,label) +! Check if DOUBLE PRECISION a equals b, and fail otherwise + double precision a, b + character*(*) label + if ( abs(a-b) .gt. 1.0d-5 ) then + call failure(label) + write(6,*) 'Got ',a,' expected ', b + end if + end + + subroutine c_c(a,b,label) +! Check if COMPLEX a equals b, and fail otherwise + complex a, b + character*(*) label + if ( abs(a-b) .gt. 1.0e-5 ) then + call failure(label) + write(6,*) 'Got ',a,' expected ', b + end if + end + subroutine p_r_r(f,x,a,label) +! Check if REAL f(x) equals a for REAL x + real f,x,a + character*(*) label + call c_r(f(x),a,label) + end + subroutine p_d_d(f,x,a,label) +! Check if DOUBLE PRECISION f(x) equals a for DOUBLE PRECISION x + double precision f,x,a + character*(*) label + call c_d(f(x),a,label) + end + subroutine p_c_c(f,x,a,label) +! Check if COMPLEX f(x) equals a for COMPLEX x + complex f,x,a + character*(*) label + call c_c(f(x),a,label) + end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/data.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/data.f90 new file mode 100644 index 00000000000..81954e222b5 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/data.f90 @@ -0,0 +1,72 @@ + ! Program to test data statement + program data + call sub1() + call sub2() + end + subroutine sub1() + integer i + type tmp + integer, dimension(4)::a + real :: r + end type + type tmp1 + type (tmp) t1(4) + integer b + end type + type (tmp1) tmp2(2) + ! Full array and scalar component initializer + data tmp2(2)%t1(2)%r, tmp2(1)%t1(3)%a, tmp2(1)%b/220,136,137,138,139,10/ + data tmp2(2)%t1(4)%a,tmp2(2)%t1(3)%a/241,242,4*5,233,234/ + ! implied DO + data (tmp2(1)%t1(2)%a(i),i=4,1,-1)/124,123,122,121/ + ! array section + data tmp2(1)%t1(4)%a(4:1:-1)/144,143,142,141/ + data tmp2(1)%t1(1)%a(1:4:2)/111,113/ + ! array element reference + data tmp2(2)%t1(2)%a(3), tmp2(2)%t1(2)%a(1)/223,221/ + + if (any(tmp2(1)%t1(1)%a .ne. (/111,0,113,0/))) call abort + if (tmp2(1)%t1(1)%r .ne. 0.0) call abort + if (tmp2(1)%b .ne. 10) call abort + + if (any(tmp2(1)%t1(2)%a .ne. (/121,122,123,124/))) call abort + if (tmp2(1)%t1(2)%r .ne. 0.0) call abort + if (tmp2(1)%b .ne. 10) call abort + + if (any(tmp2(1)%t1(3)%a .ne. (/136,137,138,139/))) call abort + if (tmp2(1)%t1(3)%r .ne. 0.0) call abort + if (tmp2(1)%b .ne. 10) call abort + + if (any(tmp2(1)%t1(4)%a .ne. (/141,142,143,144/))) call abort + if (tmp2(1)%t1(4)%r .ne. 0.0) call abort + if (tmp2(1)%b .ne. 10) call abort + + if (any(tmp2(2)%t1(1)%a .ne. (/0,0,0,0/))) call abort + if (tmp2(2)%t1(1)%r .ne. 0.0) call abort + if (tmp2(2)%b .ne. 0) call abort + + if (any(tmp2(2)%t1(2)%a .ne. (/221,0,223,0/))) call abort + if (tmp2(2)%t1(2)%r .ne. 220.0) call abort + if (tmp2(2)%b .ne. 0) call abort + + if (any(tmp2(2)%t1(3)%a .ne. (/5,5,233,234/))) call abort + if (tmp2(2)%t1(3)%r .ne. 0.0) call abort + if (tmp2(2)%b .ne. 0) call abort + + if (any(tmp2(2)%t1(4)%a .ne. (/241,242,5,5/))) call abort + if (tmp2(2)%t1(4)%r .ne. 0.0) call abort + if (tmp2(2)%b .ne. 0) call abort + + end + subroutine sub2() + integer a(4,4), b(10) + integer i,j,k + real r,t + data i,j,r,k,t,b(5),b(2),((a(i,j),i=1,4,1),j=4,1,-1)/1,2,3,4,5,5,2,& + 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/ + if ((i.ne.1) .and. (j.ne.2).and.(k.ne.4)) call abort + if ((r.ne.3.0).and.(t.ne.5.0)) call abort + if (any(b.ne.(/0,2,0,0,5,0,0,0,0,0/))) call abort + if (any(a.ne.reshape((/13,14,15,16,9,10,11,12,5,6,7,8,1,2,3,4/),(/4,4/)))) call abort + end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/data_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/data_2.f90 new file mode 100644 index 00000000000..0aa44f6052a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/data_2.f90 @@ -0,0 +1,17 @@ +! Check more array variants of the data statement +program data_2 + implicit none + type t + integer i + end type t + integer, dimension(3) :: a + type (t), dimension(3) :: b + integer, dimension(2,2) :: c + data a(:), b%i /1, 2, 3, 4, 5, 6/ + data c(1, :), c(2, :) /7, 8, 9, 10/ + + if (any (a .ne. (/1, 2, 3/))) call abort () + if (any (b%i .ne. (/4, 5, 6/))) call abort () + if ((any (c(1, :) .ne. (/7, 8/))) & + .or. (any (c(2,:) .ne. (/9, 10/)))) call abort () +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/dep_fails.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/dep_fails.f90 new file mode 100644 index 00000000000..c8eec5c73ac --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/dep_fails.f90 @@ -0,0 +1,50 @@ +! This gives incorrect results when compiled with +! the intel and pgf90 compilers +Program Strange + + Implicit None + + Type Link + Integer, Dimension(2) :: Next + End Type Link + + Integer, Parameter :: N = 2 + Integer, dimension (2, 4) :: results + Integer :: i, j + + Type(Link), Dimension(:,:), Pointer :: Perm + Integer, Dimension(2) :: Current + + Allocate (Perm(N,N)) + +! Print*, 'Spanned by indices' + Do i = 1, N**2 + Perm(mod(i-1,N)+1, (i-1)/N+1)%Next = (/ Mod(i,N) + 1, Mod(i/N+1,N)+1/) +! Write(*,100) mod(i-1,N)+1, (i-1)/N+1, Perm(mod(i-1,N)+1, (i-1)/N+1)%Next +! Expected output: +! Spanned by indices +! 1 1---> 2 2 +! 2 1---> 1 1 +! 1 2---> 2 1 +! 2 2---> 1 2 + End Do + +! Print*, 'Spanned as a cycle' + Current = (/1,1/) + Do i = 1, n**2 + results (:, i) = Perm(Current(1), Current(2))%Next +! Write(*,100) Current, Perm(Current(1), Current(2))%Next +! Expected output: +! 1 1---> 2 2 +! 2 2---> 1 2 +! 1 2---> 2 1 +! 2 1---> 1 1 + Current = Perm(Current(1), Current(2))%Next + End Do + + if (any(results .ne. reshape ((/2,2,1,2,2,1,1,1/), (/2, 4/)))) call abort + +! 100 Format( 2I3, '--->', 2I3) + DeAllocate (Perm) + +End Program Strange diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_init.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_init.f90 new file mode 100644 index 00000000000..72531f9acf6 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_init.f90 @@ -0,0 +1,32 @@ +! Program to test derived type initializers and constructors +program der_init + implicit none + type t + integer :: i + integer :: j = 4 + end type + integer :: m, n + + ! Explicit initializer + type (t) :: var = t(1, 2) + ! Type (default) initializer + type (t) :: var2 + ! Initialization of arrays + type (t), dimension(2) :: var3 + type (t), dimension(2) :: var4 = (/t(7, 9), t(8, 6)/) + + if (var%i .ne. 1 .or. var%j .ne. 2) call abort + if (var2%j .ne. 4) call abort + var2 = t(6, 5) + if (var2%i .ne. 6 .or. var2%j .ne. 5) call abort + + if ((var3(1)%j .ne. 4) .or. (var3(2)%j .ne. 4)) call abort + if ((var4(1)%i .ne. 7) .or. (var4(2)%i .ne. 8) & + .or. (var4(1)%j .ne. 9) .or. (var4(2)%j .ne. 6)) call abort + + ! Non-constant constructor + n = 1 + m = 5 + var2 = t(n, n + m) + if (var2%i .ne. 1 .or. var2%j .ne. 6) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_io.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_io.f90 new file mode 100644 index 00000000000..0e9b0716654 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_io.f90 @@ -0,0 +1,67 @@ +! Program to test IO of derived types +program derived_io + character(100) :: buf1, buf2, buf3 + + type xyz_type + integer :: x + character(11) :: y + logical :: z + end type xyz_type + + type abcdef_type + integer :: a + logical :: b + type (xyz_type) :: c + integer :: d + real(4) :: e + character(11) :: f + end type abcdef_type + + type (xyz_type), dimension(2) :: xyz + type (abcdef_type) abcdef + + xyz(1)%x = 11111 + xyz(1)%y = "hello world" + xyz(1)%z = .true. + xyz(2)%x = 0 + xyz(2)%y = "go away" + xyz(2)%z = .false. + + abcdef%a = 0 + abcdef%b = .true. + abcdef%c%x = 111 + abcdef%c%y = "bzz booo" + abcdef%c%z = .false. + abcdef%d = 3 + abcdef%e = 4.0 + abcdef%f = "kawabanga" + + write (buf1, *), xyz(1)%x, xyz(1)%y, xyz(1)%z + ! Use function call to ensure it is only evaluated once + write (buf2, *), xyz(bar()) + if (buf1.ne.buf2) call abort + + write (buf1, *), abcdef + write (buf2, *), abcdef%a, abcdef%b, abcdef%c, abcdef%d, abcdef%e, abcdef%f + write (buf3, *), abcdef%a, abcdef%b, abcdef%c%x, abcdef%c%y, & + abcdef%c%z, abcdef%d, abcdef%e, abcdef%f + if (buf1.ne.buf2) call abort + if (buf1.ne.buf3) call abort + + call foo(xyz(1)) + + contains + + subroutine foo(t) + type (xyz_type) t + write (buf1, *), t%x, t%y, t%z + write (buf2, *), t + if (buf1.ne.buf2) call abort + end subroutine foo + + integer function bar() + integer, save :: i = 1 + bar = i + i = i + 1 + end function +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_point.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_point.f90 new file mode 100644 index 00000000000..1dcb07c2108 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_point.f90 @@ -0,0 +1,45 @@ +! Program to test DERIVED type with components point to the DERIVED +! type itself, and two DERIVED type with componets point to each +! other. +program nest_derived + type record + integer :: value + type(record), pointer :: rp + end type record + + type record1 + integer value + type(record2), pointer :: r1p + end type + + type record2 + integer value + type(record1), pointer :: r2p + end type + + type(record), target :: e1, e2, e3 + type(record1), target :: r1 + type(record2), target :: r2 + nullify(r1%r1p,r2%r2p,e1%rp,e2%rp,e3%rp) + + r1%r1p => r2 + r2%r2p => r1 + e1%rp => e2 + e2%rp => e3 + + r1%value = 11 + r2%value = 22 + + e1%value = 33 + e1%rp%value = 44 + e1%rp%rp%value = 55 + + if (r1%r1p%value .ne. 22) call abort + if (r2%r2p%value .ne. 11) call abort + if (e1%value .ne. 33) call abort + if (e2%value .ne. 44) call abort + if (e3%value .ne. 55) call abort + if (r1%value .ne. 11) call abort + if (r2%value .ne. 22) call abort + +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_type.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_type.f90 new file mode 100644 index 00000000000..6a2716407bf --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_type.f90 @@ -0,0 +1,45 @@ +! Program to test derived types +program der_type + implicit none + type t1 + integer, dimension (4, 5) :: a + integer :: s + end type + + type my_type + character(20) :: c + type (t1), dimension (4, 3) :: ca + type (t1) :: r + end type + + type init_type + integer :: i = 13 + integer :: j = 14 + end type + + type (my_type) :: var + type (init_type) :: def_init + type (init_type) :: is_init = init_type (10, 11) + integer i; + + if ((def_init%i .ne. 13) .or. (def_init%j .ne. 14)) call abort + if ((is_init%i .ne. 10) .or. (is_init%j .ne. 11)) call abort + ! Passing a component as a parameter tests getting the addr of a component + call test_call(def_init%i) + var%c = "Hello World" + if (var%c .ne. "Hello World") call abort + var%r%a(:, :) = 0 + var%ca(:, :)%s = 0 + var%r%a(1, 1) = 42 + var%r%a(4, 5) = 43 + var%ca(:, :)%s = var%r%a(:, 1:5:2) + if (var%ca(1, 1)%s .ne. 42) call abort + if (var%ca(4, 3)%s .ne. 43) call abort +contains + subroutine test_call (p) + integer p + + if (p .ne. 13) call abort + end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/direct_io.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/direct_io.f90 new file mode 100644 index 00000000000..b8078f03d5e --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/direct_io.f90 @@ -0,0 +1,20 @@ +! demonstrates basic direct access using variables for REC +! pr14872 + OPEN(UNIT=10,ACCESS='DIRECT',RECL=128) + DO I = 1,10 + WRITE(10,REC=I,ERR=10)I + ENDDO + CLOSE(10) + OPEN(UNIT=10,ACCESS='DIRECT',RECL=128) + DO I = 1,10 + READ(10,REC=I,ERR=10)J + IF (J.NE.I) THEN +! PRINT*,' READ ',J,' EXPECTED ',I + CALL ABORT + ENDIF + ENDDO + STOP + 10 CONTINUE +! PRINT*,' ERR= RETURN FROM READ OR WRITE' + CALL ABORT + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/elemental.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/elemental.f90 new file mode 100644 index 00000000000..fcfe233df9c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/elemental.f90 @@ -0,0 +1,32 @@ +! Program to test elemental functions. +program test_elemental + implicit none + integer(kind = 4), dimension (2, 4) :: a + integer(kind = 4), dimension (2, 4) :: b + integer(kind = 8), dimension(2) :: c + + a = reshape ((/2, 3, 4, 5, 6, 7, 8, 9/), (/2, 4/)) + b = 0 + b(2, :) = e_fn (a(1, :), 1) + if (any (b .ne. reshape ((/0, 1, 0, 3, 0, 5, 0, 7/), (/2, 4/)))) call abort + a = e_fn (a(:, 4:1:-1), 1 + b) + if (any (a .ne. reshape ((/7, 7, 5, 3, 3, -1, 1, -5/), (/2, 4/)))) call abort + ! This tests intrinsic elemental conversion functions. + c = 2 * a(1, 1) + if (any (c .ne. 14)) call abort + + ! This triggered bug due to building ss chains in the wrong order. + b = 0; + a = a - e_fn (a, b) + if (any (a .ne. 0)) call abort + + ! Check expressions involving constants + a = e_fn (b + 1, 1) + if (any (a .ne. 0)) call abort +contains + +elemental integer function e_fn (p, q) + integer, intent(in) :: p, q + e_fn = p - q +end function +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/empty_format.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/empty_format.f90 new file mode 100644 index 00000000000..242bee8b467 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/empty_format.f90 @@ -0,0 +1,14 @@ +! from NIST test FM406.FOR + CHARACTER*10 A10VK + A10VK = 'XXXXXXXXXX' + WRITE(A10VK,39110) +39110 FORMAT() +! +! the empty format should fill the target of the internal +! write with blanks. +! + IF (A10VK.NE.'') THEN +! PRINT*,A10VK + CALL ABORT + ENDIF + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/emptyif.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/emptyif.f90 new file mode 100644 index 00000000000..0c19fa57108 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/emptyif.f90 @@ -0,0 +1,20 @@ +! Test empty if statements. We Used to fail this because we folded +! the if stmt before we finished building it. +program emptyif + implicit none + integer i + + i=1 + if(i .le. 0) then + else + i = 2 + endif + if (i .ne. 2) call abort() + + if (i .eq. 0) then + elseif (i .eq. 2) then + i = 3 + end if + if (i .ne. 3) call abort() +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp b/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp new file mode 100644 index 00000000000..a476ee945bf --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp @@ -0,0 +1,59 @@ +# Copyright (C) 2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# This file was written by Rob Savoye. (rob@cygnus.com) +# Modified and maintained by Jeffrey Wheat (cassidy@cygnus.com) + +# +# These tests come from many different contributors. +# + +if $tracelevel then { + strace $tracelevel +} + +# load support procs +load_lib fortran-torture.exp + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture-execute $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture-execute $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture-execute $testcase +} + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] { + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture-execute $testcase +} + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/f2_edit_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/f2_edit_1.f90 new file mode 100644 index 00000000000..cb2f5eacd33 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/f2_edit_1.f90 @@ -0,0 +1,10 @@ +! check F2.x edit descriptors +! PR 14746 + CHARACTER*15 LINE + RCON21 = 9. + RCON22 = .9 + WRITE(LINE,'(F2.0,1H,,F2.1)')RCON21,RCON22 + READ(LINE,'(F2.0,1X,F2.1)')XRCON21,XRCON22 + IF (RCON21.NE.XRCON21) CALL ABORT + IF (RCON22.NE.XRCON22) CALL ABORT + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall.f90 new file mode 100644 index 00000000000..b60e67fb0d7 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall.f90 @@ -0,0 +1,17 @@ +! Program to test the FORALL construct +program testforall + implicit none + integer, dimension (3, 3) :: a + integer, dimension (3) :: b + integer i + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)); + + forall (i=1:3) + b(i) = sum (a(:, i)) + end forall + + if (b(1) .ne. 6) call abort + if (b(2) .ne. 15) call abort + if (b(3) .ne. 24) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_1.f90 new file mode 100644 index 00000000000..806dede70f3 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_1.f90 @@ -0,0 +1,61 @@ +! Program to test FORALL construct +program forall_1 + + call actual_variable () + call negative_stride () + call forall_index () + +contains + subroutine actual_variable () + integer:: x = -1 + integer a(3,4) + j = 100 + + ! Actual variable 'x' and 'j' used as FORALL index + forall (x = 1:3, j = 1:4) + a (x,j) = j + end forall + if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort + if ((x.ne.-1).or.(j.ne.100)) call abort + + call actual_variable_2 (x, j, a) + end subroutine + + subroutine actual_variable_2(x, j, a) + integer x,j,x1,j1 + integer a(3,4), b(3,4) + + ! Actual variable 'x' and 'j' used as FORALL index. + forall (x=3:1:-1, j=4:1:-1) + a(x,j) = j + b(x,j) = j + end forall + + if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort + if (any (b.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort + if ((x.ne.-1).or.(j.ne.100)) call abort + end subroutine + + subroutine negative_stride () + integer a(3,4) + integer x, j + + ! FORALL with negative stride + forall (x = 3:1:-1, j = 4:1:-1) + a(x,j) = j + x + end forall + if (any (a.ne.reshape ((/2,3,4,3,4,5,4,5,6,5,6,7/), (/3,4/)))) call abort + end subroutine + + subroutine forall_index + integer a(32,32) + + ! FORALL with arbitrary number indexes + forall (i1=1:2,i2=1:2,i3=1:2,i4=1:2,i5=1:2,i6=1:2,i7=1:2,i8=1:2,i9=1:2,& + i10=1:2) + a(i1+2*i3+4*i5+8*i7+16*i9-30,i2+2*i4+4*i6+8*i8+16*i10-30) = 1 + end forall + if ((a(5,5).ne.1).or. (a(32,32).ne.1)) call abort + end subroutine + +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_2.f90 new file mode 100644 index 00000000000..92a4ff102cc --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_2.f90 @@ -0,0 +1,20 @@ +!program to test nested forall construct and forall mask +program test + implicit none + integer a(4,4) + integer i, j + + do i=1,4 + do j=1,4 + a(j,i) = j-i + enddo + enddo + forall (i=2:4, a(1,i).GT.-2) + forall (j=1:4, a(j,2).GT.0) + a(j,i) = a(j,i-1) + end forall + end forall + if (any (a.ne.reshape ((/0,1,2,3,-1,0,2,3,-2,-1,0,1,-3,-2,-1,0/),& + (/4,4/)))) call abort +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90 new file mode 100644 index 00000000000..957178c8a65 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90 @@ -0,0 +1,36 @@ +! Really test forall with temporary +program evil_forall + implicit none + type t + logical valid + integer :: s + integer, dimension(:), pointer :: p + end type + type (t), dimension (5) :: v + integer i + + allocate (v(1)%p(2)) + allocate (v(2)%p(8)) + v(3)%p => NULL() + allocate (v(4)%p(8)) + allocate (v(5)%p(2)) + + v(:)%valid = (/.true., .true., .false., .true., .true./) + v(:)%s = (/1, 8, 999, 6, 2/) + v(1)%p(:) = (/9, 10/) + v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/) + v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/) + v(5)%p(:) = (/11, 12/) + + + forall (i=1:5,v(i)%valid) + v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s) + end forall + + if (any(v(1)%p(:) .ne. (/11, 10/))) call abort + if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 17, 18, 19, 20/))) call abort + if (any(v(4)%p(:) .ne. (/1, 2, 3, 4, 5, 6, 19, 20/))) call abort + if (any(v(5)%p(:) .ne. (/9, 10/))) call abort + + ! I should really free the memory I've allocated. +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_4.f90 new file mode 100644 index 00000000000..f2dded73587 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_4.f90 @@ -0,0 +1,27 @@ +! Program to test nested forall +program forall2 + implicit none + integer a(4,4,2) + integer i, j, k, n + + a(:,:,1) = reshape((/ 1, 2, 3, 4,& + 5, 6, 7, 8,& + 9,10,11,12,& + 13,14,15,16/), (/4,4/)) + a(:,:,2) = a(:,:,1) + 16 + n=4 + k=1 + ! Mirror half the matrix + forall (i=k:n) + forall (j=1:5-i) + a(i,j,:) = a(j,i,:) + end forall + end forall + + if (any (a(:,:,1) & + .ne. reshape((/ 1, 5, 9,13,& + 2, 6,10, 8,& + 3, 7,11,12,& + 4,14,15,16/),(/4,4/)))) call abort + if (any (a(:,:,2) .ne. a(:,:,1) + 16)) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_5.f90 new file mode 100644 index 00000000000..0595adf0c89 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_5.f90 @@ -0,0 +1,28 @@ +! Program to test FORALL with pointer assignment inside it. +program forall_5 + type element + integer, pointer, dimension(:)::p + end type + + type (element) q(5) + integer, target, dimension(25)::t + + n = 5 + do i = 1,5 + q(i)%p => t((i-1)*n + 1:i*n) + enddo + + forall (i = 2:5) + q(i)%p => q(i-1)%p + end forall + + do i = 1, 25 + t(i) = i + enddo + + if (any(q(1)%p .ne. (/1,2,3,4,5/))) call abort + if (any(q(2)%p .ne. (/1,2,3,4,5/))) call abort + if (any(q(3)%p .ne. (/6,7,8,9,10/))) call abort + if (any(q(4)%p .ne. (/11,12,13,14,15/))) call abort + if (any(q(5)%p .ne. (/16,17,18,19,20/))) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_6.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_6.f90 new file mode 100644 index 00000000000..b277814fb3f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_6.f90 @@ -0,0 +1,25 @@ +! Program to test FORALL with scalar pointer assignment inside it. +program forall_6 + type element + real, pointer :: p + end type + + type (element) q(5) + real, target, dimension(5) :: t + integer i; + + t = (/1.0, 2.0, 3.0, 4.0, 5.0/) + + do i = 1,5 + q(i)%p => t(i) + end do + + forall (i = 1:5) + q(i)%p => q(6 - i)%p + end forall + + + do i = 1,5 + if (q(i)%p .ne. t(6 - i)) call abort + end do +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/function_module_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/function_module_1.f90 new file mode 100644 index 00000000000..e57ff161d29 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/function_module_1.f90 @@ -0,0 +1,36 @@ +! This can fail because BB is not resolved correctly. +module M1 + +INTEGER p + +CONTAINS +subroutine AA () + implicit NONE + p = BB () + CONTAINS + subroutine AA_1 () + implicit NONE + integer :: i + i = BB () + end subroutine + + function BB() + integer :: BB + BB = 1 + end function +end subroutine + +function BB() + implicit NONE + integer :: BB + BB = 2 +end function +end module + +program P1 + USE M1 + implicit none + p = 0 + call AA () + if (p /= 1) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/hollerith.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/hollerith.f90 new file mode 100644 index 00000000000..aa7b17def75 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/hollerith.f90 @@ -0,0 +1,9 @@ +! PR 14038- 'H' in hollerith causes mangling of string +program hollerith + IMPLICIT NONE + CHARACTER*4 LINE +100 FORMAT (4H12H4) + WRITE(LINE,100) + IF (LINE .NE. '12H4') call abort () +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/initializer.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/initializer.f90 new file mode 100644 index 00000000000..55cc185f370 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/initializer.f90 @@ -0,0 +1,26 @@ +! Program to test static variable initialization +! returns the parameter from the previous invocation, or 42 on the first call. +function test (parm) + implicit none + integer test, parm + integer :: val = 42 + + test = val + val = parm +end function + +program intializer + implicit none + integer test + character(11) :: c = "Hello World" + character(15) :: d = "Teststring" + integer, dimension(3) :: a = 1 + + if (any (a .ne. 1)) call abort + if (test(11) .ne. 42) call abort + ! The second call should return + if (test(0) .ne. 11) call abort + + if (c .ne. "Hello World") call abort + if (d .ne. "Teststring") call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/inquire_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_1.f90 new file mode 100644 index 00000000000..492f74476d3 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_1.f90 @@ -0,0 +1,8 @@ +! PR 14831 + CHARACTER*4 BLANK + CHARACTER*10 ACCESS + OPEN(UNIT=9,ACCESS='SEQUENTIAL') + INQUIRE(UNIT=9,ACCESS=ACCESS,BLANK=BLANK) + IF(BLANK.NE.'NULL') CALL ABORT + IF(ACCESS.NE.'SEQUENTIAL') CALL ABORT + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/inquire_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_2.f90 new file mode 100644 index 00000000000..bc7ea74c39a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_2.f90 @@ -0,0 +1,6 @@ +! PR 14837 + INTEGER UNIT + OPEN(FILE='CSEQ', UNIT=23) + INQUIRE(FILE='CSEQ',NUMBER=UNIT) + IF (UNIT.NE.23) CALL ABORT + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/inquire_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_3.f90 new file mode 100644 index 00000000000..8967dcfbc0f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_3.f90 @@ -0,0 +1,13 @@ +! pr14836 + OPEN(UNIT=9, ACCESS='DIRECT', RECL=80, FORM='UNFORMATTED') + INQUIRE(UNIT=9,NEXTREC=NREC) + WRITE(UNIT=9,REC=5) 1 + INQUIRE(UNIT=9,NEXTREC=NREC) +! PRINT*,NREC + IF (NREC.NE.6) CALL ABORT + READ(UNIT=9,REC=1) MVI + INQUIRE(UNIT=9,NEXTREC=NREC) + IF (NREC.NE.2) CALL ABORT +! PRINT*,NREC + END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90 new file mode 100644 index 00000000000..5b94ad232bc --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_4.f90 @@ -0,0 +1,20 @@ +! pr 14904 +! inquire lastrec not correct when two records written +! with one write statement + OPEN(UNIT=10,ACCESS='DIRECT',FORM='FORMATTED',RECL=120) + 100 FORMAT(I4) + WRITE(UNIT=10,REC=1,FMT=100)1 + INQUIRE(UNIT=10,NEXTREC=J) + IF (J.NE.2) THEN +! PRINT*,'NEXTREC RETURNED ',J,' EXPECTED 2' + CALL ABORT + ENDIF + 200 FORMAT(I4,/,I4) + WRITE(UNIT=10,REC=2,FMT=200)2,3 + INQUIRE(UNIT=10,NEXTREC=J) + IF (J.NE.4) THEN +! PRINT*,'NEXTREC RETURNED ',J,' EXPECTED 4' + CALL ABORT + ENDIF + END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/integer_select.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/integer_select.f90 new file mode 100644 index 00000000000..148cd394e68 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/integer_select.f90 @@ -0,0 +1,71 @@ +PROGRAM Test_INTEGER_select + +! Every wrong branch leads to destruction. + + INTEGER, PARAMETER :: maxI = HUGE (maxI) + INTEGER, PARAMETER :: minI = -1 * maxI + INTEGER :: I = 0 + + SELECT CASE (I) + CASE (:-1) + CALL abort + CASE (1:) + CALL abort + CASE DEFAULT + CONTINUE + END SELECT + + SELECT CASE (I) + CASE (3,2,1) + CALL abort + CASE (0) + CONTINUE + CASE DEFAULT + call abort + END SELECT + +! Not aborted by here, so it worked +! See about weird corner cases + + I = maxI + + SELECT CASE (I) + CASE (:-1) + CALL abort + CASE (1:) + CONTINUE + CASE DEFAULT + CALL abort + END SELECT + + SELECT CASE (I) + CASE (3,2,1,:0) + CALL abort + CASE (maxI) + CONTINUE + CASE DEFAULT + call abort + END SELECT + + I = minI + + SELECT CASE (I) + CASE (:-1) + CONTINUE + CASE (1:) + CALL abort + CASE DEFAULT + CALL abort + END SELECT + + SELECT CASE (I) + CASE (3:,2,1,0) + CALL abort + CASE (minI) + CONTINUE + CASE DEFAULT + call abort + END SELECT + +END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/integer_select_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/integer_select_1.f90 new file mode 100644 index 00000000000..cd9bb00a98c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/integer_select_1.f90 @@ -0,0 +1,31 @@ +INTEGER :: I = 1 +SELECT CASE (I) + CASE (-3:-5) ! Can never be matched + CALL abort + CASE (1) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +I = -3 +SELECT CASE (I) + CASE (-3:-5) ! Can never be matched + CALL abort + CASE (1) + CONTINUE + CASE DEFAULT + CONTINUE +END SELECT + +I = -5 +SELECT CASE (I) + CASE (-3:-5) ! Can never be matched + CALL abort + CASE (-5) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT +END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/internal_write.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/internal_write.f90 new file mode 100644 index 00000000000..1e492977b06 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/internal_write.f90 @@ -0,0 +1,11 @@ +! PR 14901 +! Internal writes were appending CR after the last char +! written by the format statement. + CHARACTER*10 A + WRITE(A,'(3HGCC)') + IF (A.NE.'GCC ') THEN +! PRINT*,'A was not filled correctly by internal write' +! PRINT*,' A = ',A + CALL ABORT + ENDIF + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_abs.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_abs.f90 new file mode 100644 index 00000000000..9e44657bad1 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_abs.f90 @@ -0,0 +1,33 @@ +! Program to test the ABS intrinsic +program intrinsic_abs + implicit none + integer i + real(kind=4) r + real(kind=8) q + complex z + + i = 42 + i = abs(i) + if (i .ne. 42) call abort + i = -43 + i = abs(i) + if (i .ne. 43) call abort + + r = 42.0 + r = abs(r) + if (r .ne. 42.0) call abort + r = -43.0 + r = abs(r) + if (r .ne. 43.0) call abort + + q = 42.0_8 + q = abs(q) + if (q .ne. 42.0_8) call abort + q = -43.0_8 + q = abs(q) + if (q .ne. 43.0_8) call abort + + z = (3, 4) + r = abs(z) + if (r .ne. 5) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_achar.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_achar.f90 new file mode 100644 index 00000000000..fba0a08974f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_achar.f90 @@ -0,0 +1,9 @@ +! Program to test the ACHAR and IACHAR intrinsics +program intrinsic_achar + integer i + + i = 32 + if (achar(i) .ne. " ") call abort + i = iachar("A") + if ((i .ne. 65) .or. char(i) .ne. "A") call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_aint_anint.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_aint_anint.f90 new file mode 100644 index 00000000000..16e816c6bd0 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_aint_anint.f90 @@ -0,0 +1,55 @@ +! Program to test AINT and ANINT intrinsics + +subroutine real4test (op, res1, res2) + implicit none + real(kind=4) :: op + real(kind=4) :: res1, res2 + + if (diff(aint(op), res1) .or. & + diff(anint(op), res2)) call abort +contains +function diff(a, b) + real(kind=4) :: a, b + logical diff + + diff = (abs (a - b) .gt. abs(a * 1e-6)) +end function +end subroutine + +subroutine real8test (op, res1, res2) + implicit none + real(kind=8) :: op + real(kind=8) :: res1, res2 + + if (diff(aint(op), res1) .or. & + diff(anint(op), res2)) call abort +contains +function diff(a, b) + real(kind=8) :: a, b + logical diff + + diff = (abs(a - b) .gt. abs(a * 1e-6)) +end function +end subroutine + +program aint_aninttest + implicit none + + call real4test (3.456, 3.0, 3.0) + call real4test (-2.798, -2.0, -3.0) + call real4test (3.678, 3.0, 4.0) + call real4test (-1.375, -1.0, -1.0) + call real4test (-0.5, 0.0,-1.0) + call real4test (0.4, 0.0,0.0) + + call real8test (3.456_8, 3.0_8, 3.0_8) + call real8test (-2.798_8, -2.0_8, -3.0_8) + call real8test (3.678_8, 3.0_8, 4.0_8) + call real8test (-1.375_8, -1.0_8, -1.0_8) + call real8test (-0.5_8, 0.0_8,-1.0_8) + call real8test (0.4_8, 0.0_8,0.0_8) + + ! Check large numbers + call real4test (2e34, 2e34, 2e34) + call real4test (-2e34, -2e34, -2e34) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 new file mode 100644 index 00000000000..d1b99dacb5d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 @@ -0,0 +1,26 @@ +! Program to test the ANY and ALL intrinsics +program anyall + implicit none + logical, dimension(3, 3) :: a + logical, dimension(3) :: b + + a = .false. + if (any(a)) call abort + a(1, 1) = .true. + a(2, 3) = .true. + if (.not. any(a)) call abort + b = any(a, 1) + if (.not. b(1)) call abort + if (b(2)) call abort + if (.not. b(3)) call abort + + a = .true. + if (.not. all(a)) call abort + a(1, 1) = .false. + a(2, 3) = .false. + if (all(a)) call abort + b = all(a, 1) + if (b(1)) call abort + if (.not. b(2)) call abort + if (b(3)) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90 new file mode 100644 index 00000000000..24d647ef15a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90 @@ -0,0 +1,137 @@ +! Program to test the ASSOCIATED intrinsic. +program intrinsic_associated + call pointer_to_section () + call associate_1 () + call pointer_to_derived_1 () + call associated_2 () +end + +subroutine pointer_to_section () + integer, dimension(100, 100), target :: xy + integer, dimension(:, :), pointer :: window + integer i, j, k, m, n + data xy /10000*0/ + logical t + + window => xy(10:50, 30:60) + window = 10 + window (1, 1) = 0101 + window (41, 31) = 4161 + window (41, 1) = 4101 + window (1, 31) = 0161 + + t = associated (window, xy(10:50, 30:60)) + if (.not.t) call abort () + if (window(1, 1) .ne. xy(10, 30)) call abort () + if (window(41, 31) .ne. xy(50, 60)) call abort () + if (window(1, 31) .ne. xy(10, 60)) call abort () + if (window(41, 1) .ne. xy(50, 30)) call abort () + if (xy(9, 29) .ne. 0) call abort () + if (xy(51,29 ) .ne. 0) call abort () + if (xy(9, 60) .ne. 0) call abort () + if (xy(51, 60) .ne. 0) call abort () + if (xy(11, 31) .ne. 10) call abort () + if (xy(49, 59) .ne. 10) call abort () + if (xy(11, 59) .ne. 10) call abort () + if (xy(49, 31) .ne. 10) call abort () +end + +subroutine sub1 (a, ap) + integer, pointer :: ap(:, :) + integer, target :: a(10, 10) + + ap => a +end + +subroutine nullify_pp (a) + integer, pointer :: a(:, :) + + if (.not. associated (a)) call abort () + nullify (a) +end + +subroutine associate_1 () + integer, pointer :: a(:, :), b(:, :) + interface + subroutine nullify_pp (a) + integer, pointer :: a(:, :) + end subroutine nullify_pp + end interface + + allocate (a(80, 80)) + b => a + if (.not. associated(a)) call abort () + if (.not. associated(b)) call abort () + call nullify_pp (a) + if (associated (a)) call abort () + if (.not. associated (b)) call abort () +end + +subroutine pointer_to_derived_1 () + type record + integer :: value + type(record), pointer :: rp + end type record + + type record1 + integer value + type(record2), pointer :: r1p + end type + + type record2 + integer value + type(record1), pointer :: r2p + end type + + type(record), target :: e1, e2, e3 + type(record1), target :: r1 + type(record2), target :: r2 + + nullify (r1%r1p, r2%r2p, e1%rp, e2%rp, e3%rp) + if (associated (r1%r1p)) call abort () + if (associated (r2%r2p)) call abort () + if (associated (e2%rp)) call abort () + if (associated (e1%rp)) call abort () + if (associated (e3%rp)) call abort () + r1%r1p => r2 + r2%r2p => r1 + r1%value = 11 + r2%value = 22 + e1%rp => e2 + e2%rp => e3 + e1%value = 33 + e1%rp%value = 44 + e1%rp%rp%value = 55 + if (.not. associated (r1%r1p)) call abort () + if (.not. associated (r2%r2p)) call abort () + if (.not. associated (e1%rp)) call abort () + if (.not. associated (e2%rp)) call abort () + if (associated (e3%rp)) call abort () + if (r1%r1p%value .ne. 22) call abort () + if (r2%r2p%value .ne. 11) call abort () + if (e1%value .ne. 33) call abort () + if (e2%value .ne. 44) call abort () + if (e3%value .ne. 55) call abort () + if (r1%value .ne. 11) call abort () + if (r2%value .ne. 22) call abort () + +end + +subroutine associated_2 () + integer, pointer :: xp(:, :) + integer, target :: x(10, 10) + integer, target :: y(100, 100) + interface + subroutine sub1 (a, ap) + integer, pointer :: ap(:, :) + integer, target :: a(10, 1) + end + endinterface + + xp => y + if (.not. associated (xp)) call abort () + call sub1 (x, xp) + if (associated (xp, y)) call abort () + if (.not. associated (xp, x)) call abort () +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated_2.f90 new file mode 100644 index 00000000000..5f353b2f85b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated_2.f90 @@ -0,0 +1,36 @@ +! Program to test the ASSOCIATED intrinsic with cross-kinds +program intrinsic_associated_2 + logical*4 :: t4, L44, L48 + logical*8 :: t8, L84, L88 + real*4, pointer :: a4p(:, :) + real*8, pointer :: a8p(:, :) + real*4, target :: a4(10, 10) + real*8, target :: a8(10, 10) + + t4 = .true. + t8 = .true. + t8 = t4 + a4p => a4 + a8p => a8 + L44 = t4 .and. associated (a4p, a4) + L84 = t8 .and. associated (a4p, a4) + L48 = t4 .and. associated (a8p, a8) + L88 = t8 .and. associated (a8p, a8) + if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort () + + nullify (a4p, a8p) + L44 = t4 .and. associated (a4p, a4) + L84 = t8 .and. associated (a4p, a4) + L48 = t4 .and. associated (a8p, a8) + L88 = t8 .and. associated (a8p, a8) + if (L44 .and. L84 .and. L48 .and. L88) call abort () + + a4p => a4(1:10:2, 1:10:2) + a8p => a8(1:4, 1:4) + L44 = t4 .and. associated (a4p, a4(1:10:2, 1:10:2)) + L84 = t8 .and. associated (a4p, a4(1:10:2, 1:10:2)) + L48 = t4 .and. associated (a8p, a8(1:4, 1:4)) + L88 = t8 .and. associated (a8p, a8(1:4, 1:4)) + if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort () +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_bitops.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_bitops.f90 new file mode 100644 index 00000000000..95ff44c999e --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_bitops.f90 @@ -0,0 +1,29 @@ +! Program to test intrinsic bitops +program intrinsic_bitops + implicit none + integer(kind=4) :: i, j, k, o, t + integer(kind=8) :: a, b, c + + o = 0 + i = 2 + j = 3 + k = 12 + + if (.not. btest (i, o+1)) call abort + if (btest (i, o+2)) call abort + if (iand (i, j) .ne. 2) call abort + if (ibclr (j, o+1) .ne. 1) call abort + if (ibclr (j, o+2) .ne. 3) call abort + if (ibits (k, o+1, o+2) .ne. 2) call abort + if (ibset (j, o+1) .ne. 3) call abort + if (ibset (j, o+2) .ne. 7) call abort + if (ieor (i, j) .ne. 1) call abort + if (ior (i, j) .ne. 3) call abort + if (ishft (k, o+2) .ne. 48) call abort + if (ishft (k, o-3) .ne. 1) call abort + if (ishft (k, o) .ne. 12) call abort + if (ishftc (k, o+30) .ne. 3) call abort + if (ishftc (k, o-30) .ne. 48) call abort + if (ishftc (k, o+1, o+3) .ne. 9) call abort + if (not (i) .ne. -3) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 new file mode 100644 index 00000000000..a2de59fb985 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 @@ -0,0 +1,21 @@ +! Program to test the COUNT intrinsic +program intrinsic_count + implicit none + logical(kind=4), dimension (3, 5) :: a + integer(kind=4), dimension (5) :: b + integer i + + a = .false. + if (count(a) .ne. 0) call abort + a = .true. + if (count(a) .ne. 15) call abort + a(1, 1) = .false. + a(2, 2) = .false. + a(2, 5) = .false. + if (count(a) .ne. 12) call abort + + b(1:3) = count(a, 2); + if (b(1) .ne. 4) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 5) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_cshift.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_cshift.f90 new file mode 100644 index 00000000000..f188cd8f4bb --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_cshift.f90 @@ -0,0 +1,43 @@ +! Program to test the cshift intrinsic +program intrinsic_cshift + integer, dimension(3, 3) :: a + integer, dimension(3, 3, 2) :: b + + ! Scalar shift + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = cshift (a, 1, 1) + if (any (a .ne. reshape ((/2, 3, 1, 5, 6, 4, 8, 9, 7/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = cshift (a, -2, dim = 2) + if (any (a .ne. reshape ((/4, 5, 6, 7, 8, 9, 1, 2, 3/), (/3, 3/)))) & + call abort + + ! Array shift + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = cshift (a, (/1, 0, -1/)) + if (any (a .ne. reshape ((/2, 3, 1, 4, 5, 6, 9, 7, 8/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = cshift (a, (/2, -2, 0/), dim = 2) + if (any (a .ne. reshape ((/7, 5, 3, 1, 8, 6, 4, 2, 9/), (/3, 3/)))) & + call abort + + ! Test arrays > rank 2 + b = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 14, 15, 16, 17,& + 18, 19/), (/3, 3, 2/)) + b = cshift (b, 1) + if (any (b .ne. reshape ((/2, 3, 1, 5, 6, 4, 8, 9, 7, 12, 13, 11, 15,& + 16, 14, 18, 19, 17/), (/3, 3, 2/)))) & + call abort + + b = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 14, 15, 16, 17,& + 18, 19/), (/3, 3, 2/)) + b = cshift (b, reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)), 3) + if (any (b .ne. reshape ((/11, 2, 13, 4, 15, 6, 17, 8, 19, 1, 12, 3,& + 14, 5, 16, 7, 18, 9/), (/3, 3, 2/)))) & + call abort + +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dim.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dim.f90 new file mode 100644 index 00000000000..4753de3606d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dim.f90 @@ -0,0 +1,20 @@ +! Program to test the DIM intrinsic +program intrinsic_dim + implicit none + integer i, j + real(kind=4) :: r, s + real(kind=8) :: p, q + + i = 1 + j = 4 + if (dim (i, j) .ne. 0) call abort + if (dim (j, i) .ne. 3) call abort + r = 1.0 + s = 4.0 + if (dim (r, s) .ne. 0.0) call abort + if (dim (s, r) .ne. 3.0) call abort + p = 1.0 + q = 4.0 + if (dim (p, q) .ne. 0.0) call abort + if (dim (q, p) .ne. 3.0) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dotprod.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dotprod.f90 new file mode 100644 index 00000000000..5444dd6dac1 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dotprod.f90 @@ -0,0 +1,25 @@ +! Program to test the DOT_PRODUCT intrinsic +program testforall + implicit none + integer, dimension (3) :: a + integer, dimension (3) :: b + real, dimension(3) :: c + real r + complex, dimension (2) :: z1 + complex, dimension (2) :: z2 + complex z + + a = (/1, 2, 3/); + b = (/4, 5, 6/); + c = (/4, 5, 6/); + + if (dot_product(a, b) .ne. 32) call abort + + r = dot_product(a, c) + if (abs(r - 32.0) .gt. 0.001) call abort + + z1 = (/(1.0, 2.0), (2.0, 3.0)/) + z2 = (/(3.0, 4.0), (4.0, 5.0)/) + z = dot_product (z1, z2) + if (abs (z - (34.0, -4.0)) .gt. 0.001) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dprod.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dprod.f90 new file mode 100644 index 00000000000..feb3367934b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dprod.f90 @@ -0,0 +1,13 @@ +! Program to test DPROD intrinsic +program intrinsic_dprod + implicit none + real r, s, t + double precision dp + + ! 6d60 doesn't fit in a 4-byte real + r = 2e30 + s = 4e30 + dp = dprod (r, s) + if ((dp .gt. 8.001d60) .or. (dp .lt. 7.999d60)) call abort +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dummy.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dummy.f90 new file mode 100644 index 00000000000..2e8a3401492 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dummy.f90 @@ -0,0 +1,23 @@ +! Program to test passing intrinsic functions as actual arguments for +! dummy procedures. +subroutine test (proc) + implicit none + real proc + real a, b, c + + a = 1.0 + b = sin (a) + c = proc (a) + + if (abs (b - c) .gt. 0.001) call abort + +end subroutine + +program dummy + implicit none + external test + intrinsic sin + + call test (sin) +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_eoshift.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_eoshift.f90 new file mode 100644 index 00000000000..12edc630e50 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_eoshift.f90 @@ -0,0 +1,60 @@ +! Program to test the eoshift intrinsic +program intrinsic_eoshift + integer, dimension(3, 3) :: a + integer, dimension(3, 3, 2) :: b + + ! Scalar shift and scalar bound. + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, 1, 99, 1) + if (any (a .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, -2, dim = 2) + if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) & + call abort + + ! Array shift and scalar bound. + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, (/1, 0, -1/), 99, 1) + if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 99, 7, 8/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, (/2, -2, 0/), dim = 2) + if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) & + call abort + + ! Scalar shift and array bound. + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, 1, (/99, -1, 42/), 1) + if (any (a .ne. reshape ((/2, 3, 99, 5, 6, -1, 8, 9, 42/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, -2, (/99, -1, 42/), 2) + if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) & + call abort + + ! Array shift and array bound. + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, (/1, 0, -1/), (/99, -1, 42/), 1) + if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 42, 7, 8/), (/3, 3/)))) & + call abort + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = eoshift (a, (/2, -2, 0/), (/99, -1, 42/), 2) + if (any (a .ne. reshape ((/7, -1, 3, 99, -1, 6, 99, 2, 9/), (/3, 3/)))) & + call abort + + ! Test arrays > rank 2 + b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + b = eoshift (b, 1, 99, 1) + if (any (b(:, :, 1) .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) & + call abort + if (any (b(:, :, 2) .ne. reshape ((/12, 13, 99, 15, 16, 99, 18, 19, 99/), (/3, 3/)))) & + call abort + + ! TODO: Test array sections +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 new file mode 100644 index 00000000000..a22d0b9f50a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 @@ -0,0 +1,84 @@ +!Program to test EXPONENT and FRACTION intrinsic function. + +program test_exponent_fraction + real x + integer*4 i + real*8 y + integer*8 j + equivalence (x, i), (y, j) + + x = 3. + call test_4(x) + + x = 0. + call test_4(x) + + i = o'00000000001' + call test_4(x) + + i = o'00010000000' + call test_4(x) + + i = o'17700000000' + call test_4(x) + + i = o'00004000001' + call test_4(x) + + i = o'17737777777' + call test_4(x) + + i = o'10000000000' + call test_4(x) + + i = o'0000010000' + call test_4(x) + + y = 0.5 + call test_8(y) + + y = 0. + call test_8(y) + + j = o'00000000001' + call test_8(y) + + y = 0.2938735877D-38 + call test_8(y) + + y = -1.469369D-39 + call test_8(y) + + y = z'7fe00000' + call test_8(y) + + y = -5.739719D+42 + call test_8(y) +end + +subroutine test_4(x) +real*4 x,y +integer z +y = fraction (x) +z = exponent(x) +if (z .gt. 0) then + y = (y * 2.) * (2. ** (z - 1)) +else + y = (y / 2.) * (2. ** (z + 1)) +end if +if (abs (x - y) .gt. abs(x * 1e-6)) call abort() +end + +subroutine test_8(x) +real*8 x, y +integer z +y = fraction (x) +z = exponent(x) +if (z .gt. 0) then + y = (y * 2._8) * (2._8 ** (z - 1)) +else + y = (y / 2._8) * (2._8 ** (z + 1)) +end if +if (abs (x - y) .gt. abs(x * 1e-6)) call abort() +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90 new file mode 100644 index 00000000000..9b181775f9c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90 @@ -0,0 +1,15 @@ +! Program to test the INDEX intrinsic +program test + character(len=10) a + integer w + if (index("FORTRAN", "R") .ne. 3) call abort + if (index("FORTRAN", "R", .TRUE.) .ne. 5) call abort + if (w ("FORTRAN") .ne. 3) call abort +end + +function w(str) + character(len=8) str + integer w + w = index(str, "R") +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_integer.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_integer.f90 new file mode 100644 index 00000000000..43578ed54a7 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_integer.f90 @@ -0,0 +1,18 @@ +! Program to test the real->integer conversion routines. +program intrinsic_integer + implicit none + + call test (0.0, (/0, 0, 0, 0/)) + call test (0.3, (/0, 1, 0, 0/)) + call test (0.7, (/0, 1, 0, 1/)) + call test (-0.3, (/-1, 0, 0, 0/)) + call test (-0.7, (/-1, 0, 0, -1/)) +contains +subroutine test(val, res) + real :: val + integer, dimension(4) :: res + + if ((floor(val) .ne. res(1)) .or. (ceiling(val) .ne. res(2)) & + .or. (int(val) .ne. res(3)) .or. (nint(val) .ne. res(4))) call abort +end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_len.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_len.f90 new file mode 100644 index 00000000000..6721738608f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_len.f90 @@ -0,0 +1,22 @@ +! Program to test the LEN intrinsic +program test + character(len=10) a + character(len=8) w + type person + character(len=10) name + integer age + end type person + type(person) Tom + integer n + a = w (n) + + if ((a .ne. "01234567") .or. (n .ne. 8)) call abort + if (len(Tom%name) .ne. 10) call abort +end + +function w(i) + character(len=8) w + integer i + w = "01234567" + i = len(w) +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_matmul.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_matmul.f90 new file mode 100644 index 00000000000..4b195d267bd --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_matmul.f90 @@ -0,0 +1,24 @@ +! Program to test the MATMUL intrinsic +program intrinsic_matmul + implicit none + integer, dimension(2, 3) :: a + integer, dimension(3, 2) :: b + integer, dimension(2) :: x + integer, dimension(3) :: y + integer, dimension(2, 2) :: r + integer, dimension(3) :: v + + a = reshape((/1, 2, 2, 3, 3, 4/), (/2, 3/)) + b = reshape((/1, 2, 3, 3, 4, 5/), (/3, 2/)) + x = (/1, 2/) + y = (/1, 2, 3/) + + r = matmul(a, b) + if (any(r .ne. reshape((/14, 20, 26, 38/), (/2, 2/)))) call abort + + v = matmul(x, a) + if (any(v .ne. (/5, 8, 11/))) call abort + + v(1:2) = matmul(a, y) + if (any(v(1:2) .ne. (/14, 20/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_merge.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_merge.f90 new file mode 100644 index 00000000000..b4fc18f4dd6 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_merge.f90 @@ -0,0 +1,15 @@ +! Program to test the MERGE intrinsic +program intrinsic_merge + integer, dimension(3) :: a, b + integer i + + a = (/-1, 2, 3/) + + i = 5 + if (merge (-1, 1, i .gt. 3) .ne. -1) call abort + i = 1 + if (merge (-1, 1, i .ge. 3) .ne. 1) call abort + + b = merge(a, 0, a .ge. 0) + if (any (b .ne. (/0, 2, 3/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_minmax.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_minmax.f90 new file mode 100644 index 00000000000..02feaad1523 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_minmax.f90 @@ -0,0 +1,37 @@ +! Program to test min and max intrinsics +program intrinsic_minmax + implicit none + integer i, j, k, m + real r, s, t, u + + i = 1 + j = -2 + k = 3 + m = 4 + if (min (i, k) .ne. 1) call abort + if (min (i, j, k, m) .ne. -2) call abort + if (max (i, k) .ne. 3) call abort + if (max (i, j, k, m) .ne. 4) call abort + if (max (i+1, j) .ne. 2) call abort + + r = 1 + s = -2 + t = 3 + u = 4 + if (min (r, t) .ne. 1) call abort + if (min (r, s, t, u) .ne. -2) call abort + if (max (r, t) .ne. 3) call abort + if (max (r, s, t, u) .ne. 4) call abort + + if (max (4d0, r) .ne. 4d0) call abort + if (amax0 (i, j) .ne. 1.0) call abort + if (min1 (r, s) .ne. -2) call abort + + ! Test simplify. + if (min (1, -2, 3, 4) .ne. -2) call abort + if (max (1, -2, 3, 4) .ne. 4) call abort + if (amax0 (1, -2) .ne. 1.0) call abort + if (min1 (1., -2.) .ne. -2) call abort + +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 new file mode 100644 index 00000000000..f64242af9e8 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 @@ -0,0 +1,52 @@ +! Program to test the MINLOC and MAXLOC intrinsics +program testmmloc + implicit none + integer, dimension (3, 3) :: a + integer, dimension (3) :: b + logical, dimension (3, 3) :: m + integer i + + a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/)); + + b = minloc (a, 1) + if (b(1) .ne. 1) call abort + if (b(2) .ne. 2) call abort + if (b(3) .ne. 3) call abort + + m = .true. + m(1, 1) = .false. + m(1, 2) = .false. + b = minloc (a, 1, m) + if (b(1) .ne. 2) call abort + if (b(2) .ne. 2) call abort + if (b(3) .ne. 3) call abort + + b(1:2) = minloc(a) + if (b(1) .ne. 1) call abort + if (b(2) .ne. 1) call abort + + b(1:2) = minloc(a, mask=m) + if (b(1) .ne. 2) call abort + if (b(2) .ne. 1) call abort + + b = maxloc (a, 1) + if (b(1) .ne. 3) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 1) call abort + + m = .true. + m(1, 2) = .false. + m(1, 3) = .false. + b = maxloc (a, 1, m) + if (b(1) .ne. 3) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 2) call abort + + b(1:2) = maxloc(a) + if (b(1) .ne. 1) call abort + if (b(2) .ne. 3) call abort + + b(1:2) = maxloc(a, mask=m) + if (b(1) .ne. 2) call abort + if (b(2) .ne. 3) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_2.f90 new file mode 100644 index 00000000000..5f0b5b5da1d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_2.f90 @@ -0,0 +1,22 @@ +program intrinsic_mmloc_2 + real a(-1:1), b(2:3), c(1:2) + integer, dimension(1):: i + real (kind = 8), dimension(-1:1) :: vc + + a = 0 + b = 0 + c = 0 + a(-1) = 1 + b(2) = 1 + c(1) = 1 + + if (maxloc (a, 1) .ne. 1) call abort() + if (maxloc (b, 1) .ne. 1) call abort() + if (maxloc (c, 1) .ne. 1) call abort() + + + ! We were giving MINLOC and MAXLOC the wrong return type + vc = (/4.0d0, 2.50d1, 1.0d1/) + i = minloc (vc) + if (i(1) .ne. 1) call abort() +END PROGRAM diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90 new file mode 100644 index 00000000000..2e18a29bc16 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90 @@ -0,0 +1,12 @@ +! Check we do the right thing with extreme values. +! From PR12704 +program intrinsic_mmloc_3 + integer, dimension(2) :: d + integer, dimension(2,2) :: a + + d = -huge (d) + if (maxloc (d, 1) .ne. 1) call abort() + a = huge (a) + d = minloc (a) + if (any (d .ne. 1)) call abort() +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_4.f90 new file mode 100644 index 00000000000..2a53fb0124a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_4.f90 @@ -0,0 +1,13 @@ +! Check zero sized arrays work correcly +! From PR12704 +program intrinsic_mmloc_4 + integer, allocatable, dimension(:) :: d + integer, allocatable, dimension(:,:) :: a + integer, dimension(2) :: b + + allocate (d(0)) + if (maxloc (d, 1) .ne. 0) call abort() + allocate (a(1, 0)) + b = minloc (a) + if (any (b .ne. 0)) call abort() +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 new file mode 100644 index 00000000000..368c83ba133 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 @@ -0,0 +1,28 @@ +! Program to test the MINVAL and MAXVAL intrinsics +program testmmval + implicit none + integer, dimension (3, 3) :: a + integer, dimension (3) :: b + logical, dimension (3, 3) :: m + integer i + + a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/)); + + b = minval (a, 1) + if (any(b .ne. (/1, 4, 7/))) call abort + + m = .true. + m(1, 1) = .false. + m(1, 2) = .false. + b = minval (a, 1, m) + if (any(b .ne. (/2, 4, 7/))) call abort + + b = maxval (a, 1) + if (any(b .ne. (/3, 6, 9/))) call abort + + m = .true. + m(1, 2) = .false. + m(1, 3) = .false. + b = maxval (a, 1, m) + if (any(b .ne. (/3, 6, 8/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90 new file mode 100644 index 00000000000..7050c2ccd53 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90 @@ -0,0 +1,64 @@ +! Program to test MOD and MODULO intrinsics +subroutine integertest (ops, res) + implicit none + integer, dimension(2) :: ops + integer, dimension(2) :: res + + if ((mod(ops(1), ops(2)) .ne. res(1)) .or. & + (modulo(ops(1), ops(2)) .ne. res(2))) call abort +end subroutine + +subroutine real4test (ops, res) + implicit none + real(kind=4), dimension(2) :: ops + real(kind=4), dimension(2) :: res + + if (diff(mod(ops(1), ops(2)), res(1)) .or. & + diff(modulo(ops(1), ops(2)), res(2))) call abort +contains +function diff(a, b) + real(kind=4) :: a, b + logical diff + + diff = (abs (a - b) .gt. abs(a * 1e-6)) +end function +end subroutine + +subroutine real8test (ops, res) + implicit none + real(kind=8), dimension(2) :: ops + real(kind=8), dimension(2) :: res + + if (diff(mod(ops(1), ops(2)), res(1)) .or. & + diff(modulo(ops(1), ops(2)), res(2))) call abort +contains +function diff(a, b) + real(kind=8) :: a, b + logical diff + + diff = (abs(a - b) .gt. abs(a * 1e-6)) +end function +end subroutine + +program mod_modulotest + implicit none + + call integertest ((/8, 5/), (/3, 3/)) + call integertest ((/-8, 5/), (/-3, 2/)) + call integertest ((/8, -5/), (/3, -2/)) + call integertest ((/-8, -5/), (/-3, -3/)) + + call real4test ((/3.0, 2.5/), (/0.5, 0.5/)) + call real4test ((/-3.0, 2.5/), (/-0.5, 2.0/)) + call real4test ((/3.0, -2.5/), (/0.5, -2.0/)) + call real4test ((/-3.0, -2.5/), (/-0.5, -0.5/)) + + call real8test ((/3.0_8, 2.5_8/), (/0.5_8, 0.5_8/)) + call real8test ((/-3.0_8, 2.5_8/), (/-0.5_8, 2.0_8/)) + call real8test ((/3.0_8, -2.5_8/), (/0.5_8, -2.0_8/)) + call real8test ((/-3.0_8, -2.5_8/), (/-0.5_8, -0.5_8/)) + + ! Check large numbers + call real4test ((/2e34, 1.0/), (/0.0, 0.0/)) + call real4test ((/2e34, 1.5e34/), (/0.5e34, 0.5e34/)) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 new file mode 100644 index 00000000000..99d802e6189 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 @@ -0,0 +1,71 @@ +!Program to test NEAREST intrinsic function. + +program test_nearest + real s, r, x, y, inf, max, min + integer i, infi, maxi, mini + equivalence (s,i) + equivalence (inf,infi) + equivalence (max,maxi) + equivalence (min,mini) + + r = 2.0 + s = 3.0 + call test_n (s, r) + + i = z'00800000' + call test_n (s, r) + + i = z'007fffff' + call test_n (s, r) + + i = z'00800100' + call test_n (s, r) + + s = 0 + x = nearest(s, r) + y = nearest(s, -r) + if (.not. (x .gt. s .and. y .lt. s )) call abort() + + infi = z'7f800000' + maxi = z'7f7fffff' + mini = 1 + + call test_up(max, inf) + call test_up(-inf, -max) + call test_up(0, min) + call test_up(-min, 0) + + call test_down(inf, max) + call test_down(-max, -inf) + call test_down(0, -min) + call test_down(min, 0) +end + +subroutine test_up(s, e) + real s, e, x + + x = nearest(s, 1.0) + if (x .ne. e) call abort() +end + +subroutine test_down(s, e) + real s, e, x + + x = nearest(s, -1.0) + if (x .ne. e) call abort() +end + +subroutine test_n(s1, r) + real r, s1, x + + x = nearest(s1, r) + if (nearest(x, -r) .ne. s1) call abort() + x = nearest(s1, -r) + if (nearest(x, r) .ne. s1) call abort() + + s1 = -s1 + x = nearest(s1, r) + if (nearest(x, -r) .ne. s1) call abort() + x = nearest(s1, -r) + if (nearest(x, r) .ne. s1) call abort() +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_pack.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_pack.f90 new file mode 100644 index 00000000000..565446e4e8b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_pack.f90 @@ -0,0 +1,12 @@ +! Program to test the PACK intrinsic +program intrinsic_pack + integer, dimension(3, 3) :: a + integer, dimension(6) :: b + + a = reshape ((/0, 0, 0, 0, 9, 0, 0, 0, 7/), (/3, 3/)) + b = 0 + b(1:6:3) = pack (a, a .ne. 0); + if (any (b(1:6:3) .ne. (/9, 7/))) call abort + b = pack (a(2:3, 2:3), a(2:3, 2:3) .ne. 0, (/1, 2, 3, 4, 5, 6/)); + if (any (b .ne. (/9, 7, 3, 4, 5, 6/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_present.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_present.f90 new file mode 100644 index 00000000000..d2e9981353d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_present.f90 @@ -0,0 +1,40 @@ +! Program to test the PRESENT intrinsic +program intrinsic_present + implicit none + integer a + integer, pointer :: b + integer, dimension(10) :: c + integer, pointer, dimension(:) :: d + + if (testvar()) call abort () + if (.not. testvar(a)) call abort () + if (testptr()) call abort () + if (.not. testptr(b)) call abort () + if (testarray()) call abort () + if (.not. testarray(c)) call abort () + if (testparray()) call abort () + if (.not. testparray(d)) call abort () + +contains +logical function testvar (p) + integer, optional :: p + testvar = present(p) +end function + +logical function testptr (p) + integer, pointer, optional :: p + testptr = present(p) +end function + +logical function testarray (p) + integer, dimension (10), optional :: p + testarray = present(p) +end function + +logical function testparray (p) + integer, pointer, dimension(:), optional :: p + testparray = present(p) +end function + +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 new file mode 100644 index 00000000000..102832c9f9b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 @@ -0,0 +1,25 @@ +! Program to test the PRODUCT intrinsic +program testproduct + implicit none + integer, dimension (3, 3) :: a + integer, dimension (3) :: b + logical, dimension (3, 3) :: m + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)); + + b = product (a, 1) + + if (any(b .ne. (/6, 120, 504/))) call abort + + if (product (a) .ne. 362880) call abort + + m = .true. + m(1, 1) = .false. + m(2, 1) = .false. + b = product (a, 2, m) + + if (any(b .ne. (/28, 40, 162/))) call abort + + if (product (a, mask=m) .ne. 181440) call abort + +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90 new file mode 100644 index 00000000000..0f411a633b2 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90 @@ -0,0 +1,27 @@ +!Program to test RRSPACING intrinsic function. + +program test_rrspacing + call test_real4(3.0) + call test_real4(33.0) + call test_real4(-3.0) + call test_real8(3.0_8) + call test_real8(33.0_8) + call test_real8(-33.0_8) +end +subroutine test_real4(x) + real x,y + integer p + p = 24 + y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p) + x = rrspacing(x) + if (abs (x - y) .gt. abs(x * 1e-6)) call abort +end + +subroutine test_real8(x) + real*8 x,y,t + integer p + p = 53 + y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p) + x = rrspacing(x) + if (abs (x - y) .gt. abs(x * 1e-6)) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90 new file mode 100644 index 00000000000..df483811415 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90 @@ -0,0 +1,27 @@ +!Program to test SCALE intrinsic function. + +program test_scale + call test_real4 (3.0, 2) + call test_real4 (33.0, -2) + call test_real4 (-3., 2) + call test_real4 (0, 3) + call test_real8 (0, 3) + call test_real8 (3.0_8, 4) + call test_real8 (33.0_8, -4) + call test_real8 (-33._8, 4) +end +subroutine test_real4 (x, i) + real x,y + integer i + y = x * (2.0 ** i) + x = scale (x, i) + if (abs (x - y) .gt. abs(x * 1e-6)) call abort +end + +subroutine test_real8 (x, i) + real*8 x,y + integer i + y = x * (2.0 ** i) + x = scale (x, i) + if (abs (x - y) .gt. abs(x * 1e-6)) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90 new file mode 100644 index 00000000000..da84ea7d723 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90 @@ -0,0 +1,91 @@ +!Program to test SET_EXPONENT intrinsic function. + +program test_set_exponent + call test_real4() + call test_real8() +end +subroutine test_real4() + real x,y + integer i,n + equivalence(x,i) + + n = -148 + x = 1024.0 + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + + n = 8 + x = 1024.0 + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + + n = 128 + i = o'00037777777' + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + + n = -148 + x = -1024.0 + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + + n = 8 + x = -1024.0 + y = set_exponent (x, n) + if (y .ne. -128.0) call abort() + if (exponent (y) .ne. n) call abort() + + n = 128 + i = o'20037777777' + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + +end + +subroutine test_real8() + implicit none + real*8 x, y + integer*8 i, n, low + equivalence(x, i) + + n = -1073 + x = 1024.0_8 + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + + n = 8 + x = 1024.0_8 + y = set_exponent (x, n) + if (y .ne. 128.0) call abort() + if (exponent (y) .ne. n) call abort() + + n = 1024 + low = z'ffffffff' + i = z'000fffff' + i = ishft (i, 32) + low !'000fffffffffffff' + y = set_exponent (x, n) + low = z'fffffffe' + i = z'7fefffff' + i = ishft (i, 32) + low + if (exponent (y) .ne. n) call abort() + + n = -1073 + x = -1024.0 + y = set_exponent (x, n) + low = z'00000001' + if (exponent (y) .ne. n) call abort() + + n = 8 + x = -1024.0 + y = set_exponent (x, n) + if (y .ne. -128.0) call abort() + if (exponent (y) .ne. n) call abort() + + n = 1024 + low = z'ffffffff' + i = z'800fffff' + i = ishft (i, 32) + low !z'800fffffffffffff' + y = set_exponent (x, n) + if (exponent (y) .ne. n) call abort() + +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_shape.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_shape.f90 new file mode 100644 index 00000000000..e1c5f7b4ba1 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_shape.f90 @@ -0,0 +1,22 @@ +! Program to test the shape intrinsic +program testbounds + implicit none + real, dimension(:, :), allocatable :: a + integer, dimension(2) :: j + integer i + + allocate (a(3:8, 6:7)) + + j = shape (a); + if (any (j .ne. (/ 6, 2 /))) call abort + + call test(a) +contains + +subroutine test (a) + real, dimension (1:, 1:) :: a + + if (any (shape (a) .ne. (/ 6, 2 /))) call abort +end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_si_kind.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_si_kind.f90 new file mode 100644 index 00000000000..b231dc66ebe --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_si_kind.f90 @@ -0,0 +1,35 @@ +! Program to test SELECTED_INT_KIND intrinsic function. +Program test_si_kind + integer*1 i1 + integer*2 i2 + integer*4 i4 + integer*8 i8 + integer res + real t + + t = huge (i1) + t = log10 (t) + res = selected_int_kind (int (t)) + if (res .ne. 1) call abort + + t = huge (i2) + t = log10 (t) + res = selected_int_kind (int (t)) + if (res .ne. 2) call abort + + t = huge (i4) + t = log10 (t) + res = selected_int_kind (int (t)) + if (res .ne. 4) call abort + + t = huge (i8) + t = log10 (t) + res = selected_int_kind (int (t)) + if (res .ne. 8) call abort + + i4 = huge (i4) + res = selected_int_kind (i4) + if (res .ne. (-1)) call abort + +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sign.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sign.f90 new file mode 100644 index 00000000000..fbc457d917c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sign.f90 @@ -0,0 +1,31 @@ +! Program to test SIGN intrinsic +program intrinsic_sign + implicit none + integer i, j + real r, s + + i = 2 + j = 3 + if (sign (i, j) .ne. 2) call abort + i = 4 + j = -5 + if (sign (i, j) .ne. -4) call abort + i = -6 + j = 7 + if (sign (i, j) .ne. 6) call abort + i = -8 + j = -9 + if (sign (i, j) .ne. -8) call abort + r = 1 + s = 2 + if (sign (r, s) .ne. 1) call abort + r = 1 + s = -2 + if (sign (r, s) .ne. -1) call abort + s = 0 + if (sign (r, s) .ne. 1) call abort + ! Will fail on machines which cannot represent negative zero. + s = -s ! Negative zero + if (sign (r, s) .ne. -1) call abort +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_size.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_size.f90 new file mode 100644 index 00000000000..729c55f2283 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_size.f90 @@ -0,0 +1,37 @@ +! Program to test the SIZE intrinsics +program testsize + implicit none + real, dimension(:, :), allocatable :: a + integer, dimension(5) :: j + integer, dimension(2, 3) :: b + integer i + + if (size (b(2, :), 1) .ne. 3) call abort + + allocate (a(3:8, 5:7)) + + ! With one parameter + if (size(a) .ne. 18) call abort + + ! With two parameters, assigning to an array + j = size(a, 1) + if (any (j .ne. (/6, 6, 6, 6, 6/))) call abort + + ! With a variable second parameter + i = 2 + i = size(a, i) + if (i .ne. 3) call abort + + call test(a) +contains + +subroutine test (a) + real, dimension (1:, 1:) :: a + integer i + + i = 2 + if ((size(a, 1) .ne. 6) .or. (size(a, i) .ne. 3)) call abort + if (size (a) .ne. 18 ) call abort +end subroutine +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spacing.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spacing.f90 new file mode 100644 index 00000000000..4fac9f1b303 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spacing.f90 @@ -0,0 +1,33 @@ +!Program to test SPACING intrinsic function. + +program test_spacing + call test_real4(3.0) + call test_real4(33.0) + call test_real4(-3.) + call test_real4(0) + call test_real8(0) + call test_real8(3.0_8) + call test_real8(33.0_8) + call test_real8(-33._8) +end +subroutine test_real4(x) + real x,y,t + integer p + p = 24 + y = 2.0 ** (exponent (x) - p) + t = tiny(x) + x = spacing(x) + if ((abs (x - y) .gt. abs(x * 1e-6)) & + .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort +end + +subroutine test_real8(x) + real*8 x,y,t + integer p + p = 53 + y = 2.0 ** (exponent (x) - p) + t = tiny (x) + x = spacing(x) + if ((abs (x - y) .gt. abs(x * 1e-6)) & + .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spread.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spread.f90 new file mode 100644 index 00000000000..50b66ff6c2b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_spread.f90 @@ -0,0 +1,10 @@ +program foo + integer, dimension (2, 3) :: a + integer, dimension (2, 2, 3) :: b + + a = reshape ((/1, 2, 3, 4, 5, 6/), (/2, 3/)) + b = spread (a, 1, 2) + if (any (b .ne. reshape ((/1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6/), & + (/2, 2, 3/)))) & + call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sr_kind.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sr_kind.f90 new file mode 100644 index 00000000000..fe2f978197d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sr_kind.f90 @@ -0,0 +1,61 @@ +! Program to test SELECTED_REAL_KIND intrinsic function. +Program test_sr_kind + integer res, i4, i8, t + real*4 r4 + real*8 r8 + + i4 = int (log10 (huge (r4))) + t = - int (log10 (tiny (r4))) + if (i4 .gt. t) i4 = t + + i8 = int (log10 (huge (r8))) + t = - int (log10 (tiny (r8))) + if (i8 .gt. t) i8 = t + + res = selected_real_kind (r = i4) + if (res .ne. 4) call abort + + res = selected_real_kind (r = i8) + if (res .ne. 8) call abort + + res = selected_real_kind (r = (i8 + 1)) + if (res .ne. -2) call abort + + res = selected_real_kind (p = precision (r4)) + if (res .ne. 4) call abort + + res = selected_real_kind (p = precision (r4), r = i4) + if (res .ne. 4) call abort + + res = selected_real_kind (p = precision (r4), r = i8) + if (res .ne. 8) call abort + + res = selected_real_kind (p = precision (r4), r = i8 + 1) + if (res .ne. -2) call abort + + res = selected_real_kind (p = precision (r8)) + if (res .ne. 8) call abort + + res = selected_real_kind (p = precision (r8), r = i4) + if (res .ne. 8) call abort + + res = selected_real_kind (p = precision (r8), r = i8) + if (res .ne. 8) call abort + + res = selected_real_kind (p = precision (r8), r = i8 + 1) + if (res .ne. -2) call abort + + res = selected_real_kind (p = (precision (r8) + 1)) + if (res .ne. -1) call abort + + res = selected_real_kind (p = (precision (r8) + 1), r = i4) + if (res .ne. -1) call abort + + res = selected_real_kind (p = (precision (r8) + 1), r = i8) + if (res .ne. -1) call abort + + res = selected_real_kind (p = (precision (r8) + 1), r = i8 + 1) + if (res .ne. -3) call abort + +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 new file mode 100644 index 00000000000..43f832ec63c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 @@ -0,0 +1,26 @@ +! Program to test the FORALL construct +program testforall + implicit none + integer, dimension (3, 3) :: a + integer, dimension (3) :: b + logical, dimension (3, 3) :: m + integer i + + a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)); + + if (sum(a) .ne. 45) call abort + b = sum (a, 1) + if (b(1) .ne. 6) call abort + if (b(2) .ne. 15) call abort + if (b(3) .ne. 24) call abort + + m = .true. + m(1, 1) = .false. + m(2, 1) = .false. + + if (sum (a, mask=m) .ne. 42) call abort + b = sum (a, 2, m) + if (b(1) .ne. 11) call abort + if (b(2) .ne. 13) call abort + if (b(3) .ne. 18) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_transpose.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_transpose.f90 new file mode 100644 index 00000000000..e1f268e310d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_transpose.f90 @@ -0,0 +1,24 @@ +! Program to test the transpose intrinsic +program intrinsic_transpose + integer, dimension (3, 3) :: a, b + complex(kind=8), dimension (2, 2) :: c, d + complex(kind=4), dimension (2, 2) :: e + + a = 0 + b = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) + a = transpose (b) + if (any (a .ne. reshape ((/1, 4, 7, 2, 5, 8, 3, 6, 9/), (/3, 3/)))) & + call abort + c = (0.0, 0.0) + d = reshape ((/(1d0,2d0), (3d0, 4d0), (5d0, 6d0), (7d0, 8d0)/), (/2, 2/)) + c = transpose (d); + if (any (c .ne. reshape ((/(1d0, 2d0), (5d0, 6d0), & + (3d0, 4d0), (7d0, 8d0)/), (/2, 2/)))) & + call abort (); + + e = reshape ((/(1.0,2.0), (3.0, 4.0), (5.0, 6.0), (7.0, 8.0)/), (/2, 2/)) + e = transpose (e); + if (any (e .ne. reshape ((/(1.0, 2.0), (5.0, 6.0), & + (3.0, 4.0), (7.0, 8.0)/), (/2, 2/)))) & + call abort (); +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90 new file mode 100644 index 00000000000..90e4131685a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90 @@ -0,0 +1,23 @@ +! Program to test the TRIM and REPEAT intrinsics. +program intrinsic_trim + character(len=8) a + character(len=4) b,work + a='1234 ' + b=work(9,a) + if (llt(b,"1234")) call abort() + a=' ' + b=trim(a) + if (b .gt. "") call abort() + b='12' + a=repeat(b,0) + if (a .gt. "") call abort() + a=repeat(b,2) + if (a .ne. "12 12 ") call abort() +end + +function work(i,a) + integer i + character(len=i) a + character(len=4) work + work = trim(a) +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_unpack.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_unpack.f90 new file mode 100644 index 00000000000..807aadf136f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_unpack.f90 @@ -0,0 +1,17 @@ +! Program to test the UNPACK intrinsic +program intrinsic_unpack + integer, dimension(3, 3) :: a, b + logical, dimension(3, 3) :: mask; + integer i + + mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,& + &.false.,.false.,.true./), (/3, 3/)); + a = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/)); + b = unpack ((/2, 3, 4/), mask, a) + if (any (b .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) & + call abort + b = -1 + b = unpack ((/2, 3, 4/), mask, 0) + if (any (b .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) & + call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/list_read_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/list_read_1.f90 new file mode 100644 index 00000000000..040ae72d8e0 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/list_read_1.f90 @@ -0,0 +1,53 @@ +! pr 14942, list directed io + program d + implicit none + integer i, j, m, n, nin, k + real x(3,4) + data x / 1,1,1,2,2,2,3,3,3,4,4,4 / + real y(3,4) + data y / 1,1,1,2,2,2,3,3,3,4,4,4 / + logical debug ! set me true to see the output + debug = .FALSE. + nin = 1 + n = 4 + open(unit = nin) + write(nin,*) n + do I = 1,3 + write(nin,*)(x(i,j), j=1, n) + end do + m = 3 + n = 4 + write(nin,*) m,n + do I = 1,3 + write(nin,*)(x(i,j), j=1, n) + enddo + close(nin) +! ok, the data file is written + open(unit = nin) + read(nin, fmt = *) n + if (debug ) write(*,'(A,I2)') 'n = ', n + do i = 1, 3 + do K = 1,n + x(i,k) = -1 + enddo + read(nin, fmt = *) (x(i,j), j=1, n) + if (debug) write(*, *) (x(i,j), j=1, n) + do K = 1,n + if (x(i,k).ne.y(i,k)) call abort + end do + end do + m = 0 + n = 0 + read(nin, fmt = *) m, n + if (debug) write(*,'(A,I2,2X,A,I2)') 'm = ', m, 'n = ', n + do i = 1, m + do K = 1,n + x(i,k) = -1 + enddo + read(nin, fmt = *) (x(i,j), j=1, n) + if (debug) write(*, *) (x(i,j), j=1, n) + do K = 1,n + if (x(i,k).ne.y(i,k)) call abort + end do + end do + end program d diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/logical_select_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/logical_select_1.f90 new file mode 100644 index 00000000000..60c077c4347 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/logical_select_1.f90 @@ -0,0 +1,55 @@ +LOGICAL :: L = .FALSE. + +SELECT CASE (L) + CASE (.TRUE.) + CALL abort + CASE (.FALSE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +SELECT CASE (L) + CASE (.TRUE., .FALSE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +SELECT CASE (L) + CASE (.FALSE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +SELECT CASE (L) + CASE (.NOT. .TRUE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +SELECT CASE (.NOT. L) + CASE (.TRUE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +SELECT CASE (Truth_or_Dare() .OR. L) + CASE (.TRUE.) + CONTINUE + CASE DEFAULT + CALL abort +END SELECT + +CONTAINS + + FUNCTION Truth_or_Dare () + LOGICAL Truth_or_Dare + Truth_or_Dare = .TRUE. + END FUNCTION + +END + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/mainsub.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/mainsub.f90 new file mode 100644 index 00000000000..f84e91f2525 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/mainsub.f90 @@ -0,0 +1,17 @@ +! Program to test compilation of subroutines following the main program +program mainsub + implicit none + integer i + external test + + i = 0 + call test (i) + if (i .ne. 42) call abort +end program + +subroutine test (p) + implicit none + integer p + + p = 42 +end subroutine diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/math.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/math.f90 new file mode 100644 index 00000000000..4f54dcfc7fb --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/math.f90 @@ -0,0 +1,100 @@ +! Program to test mathematical intrinsics +subroutine dotest (n, val4, val8, known) + implicit none + real(kind=4) val4, known + real(kind=8) val8 + integer n + + if (abs (val4 - known) .gt. 0.001) call abort + if (abs (real (val8, kind=4) - known) .gt. 0.001) call abort +end subroutine + +subroutine dotestc (n, val4, val8, known) + implicit none + complex(kind=4) val4, known + complex(kind=8) val8 + integer n + if (abs (val4 - known) .gt. 0.001) call abort + if (abs (cmplx (val8, kind=4) - known) .gt. 0.001) call abort +end subroutine + +program testmath + implicit none + real(kind=4) r, two4, half4 + real(kind=8) q, two8, half8 + complex(kind=4) cr + complex(kind=8) cq + external dotest, dotest2 + + two4 = 2.0 + two8 = 2.0_8 + half4 = 0.5 + half8 = 0.5_8 + r = sin (two4) + q = sin (two8) + call dotest (1, r, q, 0.9093) + r = cos (two4) + q = cos (two8) + call dotest (2, r, q, -0.4161) + r = tan (two4) + q = tan (two8) + call dotest (3, r, q, -2.1850) + r = asin (half4) + q = asin (half8) + call dotest (4, r, q, 0.5234) + r = acos (half4) + q = acos (half8) + call dotest (5, r, q, 1.0472) + r = atan (half4) + q = atan (half8) + call dotest (6, r, q, 0.4636) + r = atan2 (two4, half4) + q = atan2 (two8, half8) + call dotest (7, r, q, 1.3258) + r = exp (two4) + q = exp (two8) + call dotest (8, r, q, 7.3891) + r = log (two4) + q = log (two8) + call dotest (9, r, q, 0.6931) + r = log10 (two4) + q = log10 (two8) + call dotest (10, r, q, 0.3010) + r = sinh (two4) + q = sinh (two8) + call dotest (11, r, q, 3.6269) + r = cosh (two4) + q = cosh (two8) + call dotest (12, r, q, 3.7622) + r = tanh (two4) + q = tanh (two8) + call dotest (13, r, q, 0.9640) + r = sqrt (two4) + q = sqrt (two8) + call dotest (14, r, q, 1.4142) + + r = atan2 (0.0, 1.0) + q = atan2 (0.0_8, 1.0_8) + call dotest (15, r, q, 0.0) + r = atan2 (-1.0, 1.0) + q = atan2 (-1.0_8, 1.0_8) + call dotest (16, r, q, -0.7854) + r = atan2 (0.0, -1.0) + q = atan2 (0.0_8, -1.0_8) + call dotest (17, r, q, 3.1416) + r = atan2 (-1.0, -1.0) + q = atan2 (-1.0_8, -1.0_8) + call dotest (18, r, q, -2.3562) + r = atan2 (1.0, 0.0) + q = atan2 (1.0_8, 0.0_8) + call dotest (19, r, q, 1.5708) + r = atan2 (-1.0, 0.0) + q = atan2 (-1.0_8, 0.0_8) + call dotest (20, r, q, -1.5708) + + cr = log ((-1.0, -1.0)) + cq = log ((-1.0_8, -1.0_8)) + call dotestc (21, cr, cq, (0.3466, -2.3562)) + +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/module_interface.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/module_interface.f90 new file mode 100644 index 00000000000..86fd7914b4d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/module_interface.f90 @@ -0,0 +1,39 @@ +! We were incorrectly mangling procedures in interfaces in modules + +module module_interface + interface + subroutine foo () + end subroutine foo + end interface +contains +subroutine cs +end subroutine + +subroutine cproc + interface + subroutine bar () + end subroutine + end interface + call bar () + call foo () + call cs () +end subroutine +end module + +subroutine foo () +end subroutine + +subroutine bar () +end subroutine + +program module_interface_proc + use module_interface + interface + subroutine bar () + end subroutine + end interface + + call cproc () + call foo () + call bar () +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/module_interface_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/module_interface_2.f90 new file mode 100644 index 00000000000..dba736654c4 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/module_interface_2.f90 @@ -0,0 +1,29 @@ +! Test generic interfaces declared in modules. +! We used to get the name mangling wrong for these. +module module_interface_2 + interface foo + subroutine myfoo (i) + integer i + end subroutine + module procedure bar + end interface +contains +subroutine bar (r) + real r + + if (r .ne. 1.0) call abort () +end subroutine +end module + +subroutine myfoo (i) + integer i + + if (i .ne. 42) call abort () +end subroutine + +program test + use module_interface_2 + + call foo (42) + call foo (1.0) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/mystery_proc.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/mystery_proc.f90 new file mode 100644 index 00000000000..06fa21614ed --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/mystery_proc.f90 @@ -0,0 +1,23 @@ +! Program to test dummy procedures +subroutine bar() +end subroutine + +subroutine foo2(p) + external p + + call p() +end subroutine + +subroutine foo(p) + external p + ! We never actually discover if this is a function or a subroutine + call foo2(p) +end subroutine + +program intrinsic_minmax + implicit none + external bar + + call foo(bar) +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/nestcons.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/nestcons.f90 new file mode 100644 index 00000000000..d2d54562503 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/nestcons.f90 @@ -0,0 +1,9 @@ +! Program to test array expressions in array constructors. +program nestcons + implicit none + integer, parameter :: w1(3)= (/ 5, 6, 7/) + integer, dimension(6) :: w2 + + w2 = (/ 1, 2, w1(3:1:-1), 3 /) + if (any (w2 .ne. (/ 1, 2, 7, 6, 5, 3/))) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/parameter_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/parameter_1.f90 new file mode 100644 index 00000000000..8a8af73851d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/parameter_1.f90 @@ -0,0 +1,12 @@ +! Program to test array parameter variables. +program parameter_1 + implicit none + integer i + INTEGER, PARAMETER :: ii(10) = (/ (I,I=1,10) /) + REAL, PARAMETER :: rr(10) = ii + + do i = 1, 10 + if (ii(i) /= i) call abort() + if (rr(i) /= i) call abort() + end do +end program parameter_1 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/partparm.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/partparm.f90 new file mode 100644 index 00000000000..839ecf02f69 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/partparm.f90 @@ -0,0 +1,15 @@ +! Program to test +subroutine test (p) + integer, dimension (3) :: p + + if (any (p .ne. (/ 2, 4, 6/))) call abort +end subroutine + +program partparm + implicit none + integer, dimension (2, 3) :: a + external test + + a = reshape ((/ 1, 2, 3, 4, 5, 6/), (/ 2, 3/)) + call test (a(2, :)) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/plusconst_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/plusconst_1.f90 new file mode 100644 index 00000000000..7fc3eebb15b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/plusconst_1.f90 @@ -0,0 +1,15 @@ +! PR14005 +! The GMP conversion routines object to a leading "+" +program plusconst_1 + implicit none + real p + integer i + data p /+3.1415/ + data i /+42/ + real :: q = +1.234 + integer :: j = +100 + + if ((p .ne. 3.1415) .or. (i .ne. 42) .or. (q .ne. 1.234) .or. (j .ne. 100)) & + call abort +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/power.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/power.f90 new file mode 100644 index 00000000000..91ddc73d3e4 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/power.f90 @@ -0,0 +1,43 @@ +! Program to test the power (**) operator +program testpow + implicit none + real(kind=4) r, s, two + real(kind=8) :: q + complex(kind=4) :: c + real, parameter :: del = 0.0001 + integer i + + two = 2.0 + + r = two ** 1 + if (abs (r - 2.0) .gt. del) call abort + r = two ** 2 + if (abs (r - 4.0) .gt. del) call abort + r = two ** 3 + if (abs (r - 8.0) .gt. del) call abort + r = two ** 4 + if (abs (r - 16.0) .gt. del) call abort + r = two ** 0 + if (abs (r - 1.0) .gt. del) call abort + r = two ** (-1) + if (abs (r - 0.5) .gt. del) call abort + r = two ** (-2) + if (abs (r - 0.25) .gt. del) call abort + r = two ** (-4) + if (abs (r - 0.0625) .gt. del) call abort + s = 3.0 + r = two ** s + if (abs (r - 8.0) .gt. del) call abort + s = -3.0 + r = two ** s + if (abs (r - 0.125) .gt. del) call abort + i = 3 + r = two ** i + if (abs (r - 8.0) .gt. del) call abort + i = -3 + r = two ** i + if (abs (r - 0.125) .gt. del) call abort + c = (2.0, 3.0) + c = c ** two + if (abs(c - (-5.0, 12.0)) .gt. del) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/procarg.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/procarg.f90 new file mode 100644 index 00000000000..37718f5fc43 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/procarg.f90 @@ -0,0 +1,29 @@ +! Pogram to test +subroutine myp (a) + implicit none + integer a + + if (a .ne. 42) call abort +end subroutine + +subroutine test2 (p) + implicit none + external p + + call p(42) +end subroutine + +subroutine test (p) + implicit none + external p, test2 + + call p(42) + call test2(p) +end subroutine + +program arrayio + implicit none + external test, myp + + call test (myp) +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/ptr.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/ptr.f90 new file mode 100644 index 00000000000..2675f0866c2 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/ptr.f90 @@ -0,0 +1,20 @@ +program ptr + implicit none + integer, pointer, dimension(:) :: a, b + integer, pointer :: p + integer, target :: i + + allocate (a(1:6)) + + a = (/ 1, 2, 3, 4, 5, 6 /) + b => a + if (any (b .ne. (/ 1, 2, 3, 4, 5, 6 /))) call abort + b => a(1:6:2) + if (any (b .ne. (/ 1, 3, 5/))) call abort + + p => i + i = 42 + if (p .ne. 42) call abort + p => a(4) + if (p .ne. 4) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/read_eof.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/read_eof.f90 new file mode 100644 index 00000000000..92e454025b5 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/read_eof.f90 @@ -0,0 +1,5 @@ +! PR 13919, segfault when file is empty + open(unit=8,file='/dev/null') + read(8,*,end=1)i +1 continue + end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/retarray.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/retarray.f90 new file mode 100644 index 00000000000..a0bdc97c47d --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/retarray.f90 @@ -0,0 +1,45 @@ +! Program to test functions returning arrays + +program testfnarray + implicit none + integer, dimension (6, 5) :: a + integer n + +! These first two shouldn't require a temporary. + a = 0 + a = test(6, 5) + if (a(1,1) .ne. 42) call abort + if (a(6,5) .ne. 43) call abort + + a = 0 + a(1:6:2, 2:5) = test2() + if (a(1,2) .ne. 42) call abort + if (a(5,5) .ne. 43) call abort + + a = 1 + ! This requires a temporary + a = test(6, 5) - a + if (a(1,1) .ne. 41) call abort + if (a(6,5) .ne. 42) call abort + + contains + + function test (x, y) + implicit none + integer x, y + integer, dimension (1:x, 1:y) :: test + + test(1, 1) = 42 + test(x, y) = 43 + end function + + function test2 () result (foo) + implicit none + integer, dimension (3, 4) :: foo + + foo(1, 1) = 42 + foo(3, 4) = 43 + end function + +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/retarray_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/retarray_2.f90 new file mode 100644 index 00000000000..ab14dd03caf --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/retarray_2.f90 @@ -0,0 +1,20 @@ +! Procedure to test module procedures returning arrays. +! The array spec only gets applied to the result variable, not the function +! itself. As a result we missed it during resolution, and used the wrong +! calling convention (functions returning arrays must always have explicit +! interfaces). +module retarray_2 +contains + function z(a) result (aout) + integer, dimension(4) :: aout,a + aout = a + end function z +end module retarray_2 + +program retarray + use retarray_2 + integer, dimension(4) :: b, a=(/1,2,3,4/) + b = z(a) + if (any (b .ne. (/1, 2, 3, 4/))) call abort +end + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/scalarize.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize.f90 new file mode 100644 index 00000000000..63004c82797 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize.f90 @@ -0,0 +1,23 @@ +! Program to test the scalarizer +program testarray + implicit none + integer, dimension (6, 5) :: a, b + integer n + + a = 0 + do n = 1, 5 + a(4, n) = n + end do + + b(:, 5:1:-1) = a + a(1:5, 2) = a(4, :) + 1 + + ! The following expression should cause loop reordering + a(:, 2:4) = a(:, 1:3) + + do n = 1, 5 + if (a(n, 3) .ne. (n + 1)) call abort + if (b(4, n) .ne. (6 - n)) call abort + end do +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/scalarize2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize2.f90 new file mode 100644 index 00000000000..608c051d31c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize2.f90 @@ -0,0 +1,24 @@ +! Program to test the scalarizer +program testarray + implicit none + integer, dimension (:, :), allocatable :: a, b + integer n + + allocate(a(6, 5), b(6, 5)) + a = 0 + do n = 1, 5 + a(4, n) = n + end do + + b(:, 5:1:-1) = a + a(1:5, 2) = a(4, :) + 1 + + ! The following expression should cause loop reordering + a(:, 2:4) = a(:, 1:3) + + do n = 1, 5 + if (a(n, 3) .ne. (n + 1)) call abort + if (b(4, n) .ne. (6 - n)) call abort + end do +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/scalarize3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize3.f90 new file mode 100644 index 00000000000..76d41484c70 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/scalarize3.f90 @@ -0,0 +1,8 @@ +program foo + integer, dimension(3, 2) :: a + + a = reshape ((/1, 2, 3, 4, 5, 6/), (/3, 2/)) + a = a(3:1:-1, 2:1:-1); + + if (any (a .ne. reshape ((/6, 5, 4, 3, 2, 1/), (/3, 2/)))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/slash_edit.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/slash_edit.f90 new file mode 100644 index 00000000000..c73d5432a31 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/slash_edit.f90 @@ -0,0 +1,14 @@ +! pr 14762 - '/' not working in format + INTEGER N(5) + DATA N/1,2,3,4,5/ + OPEN(UNIT=7) + 100 FORMAT(I4) + WRITE(7,100)N + CLOSE(7) + OPEN(7) + 200 FORMAT(I4,///I4) + READ(7,200)I,J + CLOSE(7) + IF (I.NE.1) CALL ABORT + IF (J.NE.4) CALL ABORT + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/spec_abs.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/spec_abs.f90 new file mode 100644 index 00000000000..be8e3f7487b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/spec_abs.f90 @@ -0,0 +1,12 @@ +!pr 14056 + INTRINSIC IABS + INTEGER FF324 + IVCOMP = FF324(IABS,-7) + IF (IVCOMP.NE.8) CALL ABORT + END + INTEGER FUNCTION FF324(NINT, IDON03) + FF324 = NINT(IDON03) + 1 +! **** THE NAME NINT IS A DUMMY ARGUMENT +! AND NOT AN INTRINSIC FUNCTION REFERENCE ***** + RETURN + END diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/specifics.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/specifics.f90 new file mode 100644 index 00000000000..d9f3ff0c7b2 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/specifics.f90 @@ -0,0 +1,133 @@ +! Program to test intrinsic functions as actual arguments +subroutine test_r(fn, val, res) + real fn + real val, res + + if (diff(fn(val), res)) call abort +contains +function diff(a, b) + real a, b + logical diff + diff = (abs(a - b) .gt. 0.00001) +end function +end subroutine + +subroutine test_d(fn, val, res) + double precision fn + double precision val, res + + if (diff(fn(val), res)) call abort +contains +function diff(a, b) + double precision a, b + logical diff + diff = (abs(a - b) .gt. 0.00001d0) +end function +end subroutine + +subroutine test_r2(fn, val1, val2, res) + real fn + real val1, val2, res + + if (diff(fn(val1, val2), res)) call abort +contains +function diff(a, b) + real a, b + logical diff + diff = (abs(a - b) .gt. 0.00001) +end function +end subroutine + +subroutine test_d2(fn, val1, val2, res) + double precision fn + double precision val1, val2, res + + if (diff(fn(val1, val2), res)) call abort +contains +function diff(a, b) + double precision a, b + logical diff + diff = (abs(a - b) .gt. 0.00001d0) +end function +end subroutine + +subroutine test_dprod(fn) + if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort +end subroutine + +program specifics + intrinsic abs + intrinsic aint + intrinsic anint + intrinsic acos + intrinsic asin + intrinsic atan + intrinsic cos + intrinsic sin + intrinsic tan + intrinsic cosh + intrinsic sinh + intrinsic tanh + intrinsic alog + intrinsic exp + intrinsic sign + intrinsic amod + + intrinsic dabs + intrinsic dint + intrinsic dnint + intrinsic dacos + intrinsic dasin + intrinsic datan + intrinsic dcos + intrinsic dsin + intrinsic dtan + intrinsic dcosh + intrinsic dsinh + intrinsic dtanh + intrinsic dlog + intrinsic dexp + intrinsic dsign + intrinsic dmod + + intrinsic dprod + + !TODO: Also test complex variants + + call test_r (abs, -1.0, abs(-1.0)) + call test_r (aint, 1.7, 1.0) + call test_r (anint, 1.7, 2.0) + call test_r (acos, 0.5, acos(0.5)) + call test_r (asin, 0.5, asin(0.5)) + call test_r (atan, 0.5, atan(0.5)) + call test_r (cos, 1.0, cos(1.0)) + call test_r (sin, 1.0, sin(1.0)) + call test_r (tan, 1.0, tan(1.0)) + call test_r (cosh, 1.0, cosh(1.0)) + call test_r (sinh, 1.0, sinh(1.0)) + call test_r (tanh, 1.0, tanh(1.0)) + call test_r (alog, 2.0, alog(2.0)) + call test_r (exp, 1.0, exp(1.0)) + call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0)) + call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0)) + + call test_d (dabs, -1d0, abs(-1d0)) + call test_d (dint, 1.7d0, 1d0) + call test_d (dnint, 1.7d0, 2d0) + call test_d (dacos, 0.5d0, dacos(0.5d0)) + call test_d (dasin, 0.5d0, dasin(0.5d0)) + call test_d (datan, 0.5d0, datan(0.5d0)) + call test_d (dcos, 1d0, dcos(1d0)) + call test_d (dsin, 1d0, dsin(1d0)) + call test_d (dtan, 1d0, dtan(1d0)) + call test_d (dcosh, 1d0, dcosh(1d0)) + call test_d (dsinh, 1d0, dsinh(1d0)) + call test_d (dtanh, 1d0, dtanh(1d0)) + call test_d (dlog, 2d0, dlog(2d0)) + call test_d (dexp, 1d0, dexp(1d0)) + call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0)) + call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0)) + + call test_dprod(dprod) +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90 new file mode 100644 index 00000000000..8bde9b2f740 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90 @@ -0,0 +1,87 @@ +! Program to test STATEMENT function +program st_fuction + call simple_case + call with_function_call + call with_character_dummy + call with_derived_type_dummy + call with_pointer_dummy + call multiple_eval + +contains + subroutine simple_case + integer st1, st2 + integer c(10, 10) + st1 (i, j) = i + j + st2 (i, j) = c(i, j) + + if (st1 (1, 2) .ne. 3) call abort + c = 3 + if (st2 (1, 2) .ne. 3 .or. st2 (2, 3) .ne. 3) call abort + end subroutine + + subroutine with_function_call + integer fun, st3 + st3 (i, j) = fun (i) + fun (j) + + if (st3 (fun (2), 4) .ne. 16) call abort + end subroutine + + subroutine with_character_dummy + character (len=4) s1, s2, st4 + character (len=10) st5, s0 + st4 (i, j) = "0123456789"(i:j) + st5 (s1, s2) = s1 // s2 + + if (st4 (1, 4) .ne. "0123" ) call abort + if (st5 ("01", "02") .ne. "01 02 ") call abort + end subroutine + + subroutine with_derived_type_dummy + type person + integer age + character (len=50) name + end type person + type (person) me, p, tom + type (person) st6 + st6 (p) = p + + me%age = 5 + me%name = "Tom" + tom = st6 (me) + if (tom%age .ne. 5) call abort + if (tom%name .gt. "Tom") call abort + end subroutine + + subroutine with_pointer_dummy + character(len=4), pointer:: p, p1 + character(len=4), target:: i + character(len=6) a + a (p) = p // '10' + + p1 => i + i = '1234' + if (a (p1) .ne. '123410') call abort + end subroutine + + subroutine multiple_eval + integer st7, fun2, fun + + st7(i) = i + fun(i) + + if (st7(fun2(10)) .ne. 3) call abort + end subroutine +end + +! This functon returns the argument passed on the previous call. +integer function fun2 (i) + integer i + integer, save :: val = 1 + + fun2 = val + val = i +end function + +integer function fun (i) + integer i + fun = i * 2 +end function diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/stack_varsize.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/stack_varsize.f90 new file mode 100644 index 00000000000..f839c8e36bc --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/stack_varsize.f90 @@ -0,0 +1,30 @@ +! Program to test the stack variable size limit. +program stack + call sub1 + call sub2 (1) +contains + + ! Local variables larger than 32768 in byte size shall be placed in static + ! storage area, while others be put on stack by default. + subroutine sub1 + real a, b(32768/4), c(32768/4+1) + integer m, n(1024,4), k(1024,1024) + a = 10.0 + b = 20.0 + c = 30.0 + m = 10 + n = 20 + k = 30 + if ((a .ne. 10.0).or.(b(1) .ne. 20.0).or.(c(1) .ne. 30.0)) call abort + if ((m .ne. 10).or.(n(256,4) .ne. 20).or.(k(1,1024) .ne. 30)) call abort + end + + ! Local variables defined in recursive subroutine are always put on stack. + recursive subroutine sub2 (n) + real a (32769) + a (1) = 42 + if (n .ge. 1) call sub2 (n-1) + if (a(1) .ne. 42) call abort + a (1) = 0 + end +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/straret.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/straret.f90 new file mode 100644 index 00000000000..579e35a70a4 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/straret.f90 @@ -0,0 +1,18 @@ +! Test assumed length character functions. + +character*(*) function f() + f = "Hello" +end function + +character*6 function g() + g = "World" +end function + +program straret + character*6 f, g + character*12 v + + + v = f() // g() + if (v .ne. "Hello World ") call abort () +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strarray_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_1.f90 new file mode 100644 index 00000000000..95e9b038559 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_1.f90 @@ -0,0 +1,13 @@ +subroutine foo(i) +character c +integer i +character(1),parameter :: hex_chars(0:15)=& + (/'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'/) + +c = hex_chars(i) +if (c.ne.'3') call abort() +end + +program strarray_1 +call foo(3) +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strarray_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_2.f90 new file mode 100644 index 00000000000..dbb3b89e43f --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_2.f90 @@ -0,0 +1,14 @@ +subroutine foo(i,c) +character c +integer i +character(1),parameter :: hex_chars(0:15)=& + (/'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'/) + +c = hex_chars(i) +end + +program strarray_2 + character c + call foo(3,c) + if (c.ne.'3') call abort() +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strarray_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_3.f90 new file mode 100644 index 00000000000..9d369c7f196 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_3.f90 @@ -0,0 +1,50 @@ +program strarray_3 + character(len=5), dimension(2) :: c + + c(1) = "Hello" + c(2) = "World" + + call foo1(c) + call foo2(c, 2) + call foo3(c, 5) + call foo4(c, 5, 2) + call foo5(c(2:1:-1)) +contains +subroutine foo1(a) + implicit none + character(len=5), dimension(2) :: a + + if ((a(1) .ne. "Hello") .or. (a(2) .ne. "World")) call abort +end subroutine + +subroutine foo2(a, m) + implicit none + integer m + character(len=5), dimension(m) :: a + + if ((a(1) .ne. "Hello") .or. (a(2) .ne. "World")) call abort +end subroutine + +subroutine foo3(a, n) + implicit none + integer n + character(len=n), dimension(:) :: a + + if ((a(1) .ne. "Hello") .or. (a(2) .ne. "World")) call abort +end subroutine + +subroutine foo4(a, n, m) + implicit none + integer n, m + character(len=n), dimension(m) :: a + + if ((a(1) .ne. "Hello") .or. (a(2) .ne. "World")) call abort +end subroutine + +subroutine foo5(a) + implicit none + character(len=2), dimension(5) :: a + + if ((a(1) .ne. "Wo") .or. (a(3) .ne. "dH") .or. (a(5) .ne. "lo")) call abort +end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strarray_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_4.f90 new file mode 100644 index 00000000000..c33f4b53d69 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strarray_4.f90 @@ -0,0 +1,39 @@ +program strarray_4 + character(len=5), dimension(2) :: c + + c(1) = "Hello" + c(2) = "World" + + call foo1(c) + call foo2(c, 2) + call foo3(c, 5, 2) +contains +subroutine foo1(a) + implicit none + character(len=5), dimension(2) :: a + character(len=5), dimension(2) :: b + + b = a; + if ((b(1) .ne. "Hello") .or. (b(2) .ne. "World")) call abort +end subroutine + +subroutine foo2(a, m) + implicit none + integer m + character(len=5), dimension(m) :: a + character(len=5), dimension(m) :: b + + b = a + if ((b(1) .ne. "Hello") .or. (b(2) .ne. "World")) call abort +end subroutine + +subroutine foo3(a, n, m) + implicit none + integer n, m + character(len=n), dimension(m) :: a + character(len=n), dimension(m) :: b + + b = a + if ((b(1) .ne. "Hello") .or. (b(2) .ne. "World")) call abort +end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strcmp.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strcmp.f90 new file mode 100644 index 00000000000..26980901c7e --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strcmp.f90 @@ -0,0 +1,16 @@ +program test + implicit none + character(len=20) :: foo + + foo="hello" + + if (llt(foo, "hello")) call abort + if (.not. lle(foo, "hello")) call abort + if (lgt("hello", foo)) call abort + if (.not. lge("hello", foo)) call abort + + if (.not. llt(foo, "world")) call abort + if (.not. lle(foo, "world")) call abort + if (lgt(foo, "world")) call abort + if (lge(foo, "world")) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strcommon_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strcommon_1.f90 new file mode 100644 index 00000000000..aa51ccf4bae --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strcommon_1.f90 @@ -0,0 +1,28 @@ +! PR14081 character variables in common blocks. + +subroutine test1 + implicit none + common /block/ c + character(len=12) :: c + + if (c .ne. "Hello World") call abort +end subroutine + +subroutine test2 + implicit none + common /block/ a + character(len=6), dimension(2) :: a + + if ((a(1) .ne. "Hello") .or. (a(2) .ne. "World")) call abort +end subroutine + +program strcommon_1 + implicit none + common /block/ s, t + character(len=6) :: s, t + s = "Hello " + t = "World " + call test1 + call test2 +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/string.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/string.f90 new file mode 100644 index 00000000000..f220f4a477b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/string.f90 @@ -0,0 +1,15 @@ +! Program to test string handling +program string + implicit none + character(len=5) :: a, b + character(len=20) :: c + + a = 'Hello' + b = 'World' + c = a//b + + if (c .ne. 'HelloWorld') call abort + if (c .eq. 'WorldHello') call abort + if (a//'World' .ne. 'HelloWorld') call abort + if (a .ge. b) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strlen.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strlen.f90 new file mode 100644 index 00000000000..17f9aa277b6 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strlen.f90 @@ -0,0 +1,34 @@ +! Program to test the LEN and LEN_TRIM intrinsics. +subroutine test (c) + character(*) c + character(len(c)) d + + d = c + if (len(d) .ne. 20) call abort + if (d .ne. "Longer Test String") call abort + c = "Hello World" +end subroutine + +subroutine test2 (c) + character (*) c + character(len(c)) d + + d = c + if (len(d) .ne. 6) call abort + if (d .ne. "Foobar") call abort +end subroutine + +program strlen + implicit none + character(20) c + character(5) a, b + integer i + + c = "Longer Test String" + call test (c) + + if (len(c) .ne. 20) call abort + if (len_trim(c) .ne. 11) call abort + + call test2 ("Foobar"); +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/strret.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/strret.f90 new file mode 100644 index 00000000000..7346fff5df7 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/strret.f90 @@ -0,0 +1,25 @@ +! Program to test caracter string return values +function test () + implicit none + character(len=10) :: test + test = "World" +end function + +function test2 () result (r) + implicit none + character(len=5) :: r + r = "Hello" +end function + +program strret + implicit none + character(len=15) :: s + character(len=10) :: test + character(len=5) :: test2 + + s = test () + if (s .ne. "World") call abort + + s = "Hello " // test () + if (s .ne. test2 () //" World") call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/test_slice.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/test_slice.f90 new file mode 100644 index 00000000000..f2291cd832a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/test_slice.f90 @@ -0,0 +1,17 @@ +! Program to test handling of reduced rank array sections. This uncovered +! bugs in simplify_shape and the scalarization of array sections. +program test_slice + implicit none + + real (kind = 8), dimension(2, 2, 2) :: x + real (kind = 8) :: min, max + + x = 1.0 + if (minval(x(1, 1:2, 1:1)) .ne. 1.0) call abort () + if (maxval(x(1, 1:2, 1:1)) .ne. 1.0) call abort () + if (any (shape(x(1, 1:2, 1:1)) .ne. (/2, 1/))) call abort () + + if (any (shape(x(1, 1:2, 1)) .ne. (/2/))) call abort () + if (any (shape(x(1:1, 1:2, 1:1)) .ne. (/1, 2, 1/))) call abort () + +end program test_slice diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/unopened_unit_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/unopened_unit_1.f90 new file mode 100644 index 00000000000..d87406ab4db --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/unopened_unit_1.f90 @@ -0,0 +1,13 @@ +! PR 14565 +program unopened_unit_1 + Integer I,J + Do I = 1,10 + Write(99,*)I + End Do + Rewind(99) + Do I = 1,10 + Read(99,*)J + If (J.ne.I) Call abort + End Do +End program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/userop.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/userop.f90 new file mode 100644 index 00000000000..4fceb476685 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/userop.f90 @@ -0,0 +1,67 @@ +module uops + implicit none + interface operator (.foo.) + module procedure myfoo + end interface + + interface operator (*) + module procedure boolmul + end interface + + interface assignment (=) + module procedure int2bool + end interface + +contains +function myfoo (lhs, rhs) + implicit none + integer myfoo + integer, intent(in) :: lhs, rhs + + myfoo = lhs + rhs +end function + +! This is deliberately different from integer multiplication +function boolmul (lhs, rhs) + implicit none + logical boolmul + logical, intent(IN) :: lhs, rhs + + boolmul = lhs .and. .not. rhs +end function + +subroutine int2bool (lhs, rhs) + implicit none + logical, intent(out) :: lhs + integer, intent(in) :: rhs + + lhs = rhs .ne. 0 +end subroutine +end module + +program me + use uops + implicit none + integer i, j + logical b, c + + b = .true. + c = .true. + if (b * c) call abort + c = .false. + if (.not. (b * c)) call abort + if (c * b) call abort + b = .false. + if (b * c) call abort + + i = 0 + b = i + if (b) call abort + i = 2 + b = i + if (.not. b) call abort + + j = 3 + if ((i .foo. j) .ne. 5) call abort +end program + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_1.f90 new file mode 100644 index 00000000000..ba1f8a62579 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_1.f90 @@ -0,0 +1,41 @@ +! Program to test WHERE inside FORALL +program where_1 + integer :: A(5,5) + + A(1,:) = (/1,0,0,0,0/) + A(2,:) = (/2,1,1,1,0/) + A(3,:) = (/1,2,2,0,2/) + A(4,:) = (/2,1,0,2,3/) + A(5,:) = (/1,0,0,0,0/) + + ! Where inside FORALL. + ! WHERE masks must be evaluated before executing the assignments + forall (I=1:5) + where (A(I,:) .EQ. 0) + A(:,I) = I + elsewhere (A(I,:) >2) + A(I,:) = 6 + endwhere + end forall + + if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 3, 0, & + 0, 1, 4, 2, 0, 0, 5, 6, 6, 5/), (/5, 5/)))) call abort + + ! Where inside DO + A(1,:) = (/1,0,0,0,0/) + A(2,:) = (/2,1,1,1,0/) + A(3,:) = (/1,2,2,0,2/) + A(4,:) = (/2,1,0,2,3/) + A(5,:) = (/1,0,0,0,0/) + + do I=1,5 + where (A(I,:) .EQ. 0) + A(:,I) = I + elsewhere (A(I,:) >2) + A(I,:) = 6 + endwhere + enddo + + if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 6, 0, & + 0, 1, 0, 2, 0, 0, 0, 5, 5, 5/), (/5, 5/)))) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_2.f90 new file mode 100644 index 00000000000..25a8dc9e7a8 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_2.f90 @@ -0,0 +1,22 @@ +! Program to test the WHERE constructs +program where_2 + integer temp(10), reduce(10) + + temp = 10 + reduce(1:3) = -1 + reduce(4:6) = 0 + reduce(7:8) = 5 + reduce(9:10) = 10 + + WHERE (reduce < 0) + temp = 100 + ELSE WHERE (reduce .EQ. 0) + temp = 200 + temp + ELSE WHERE + WHERE (reduce > 6) temp = temp + sum(reduce) + temp = 300 + temp + END WHERE + + if (any (temp .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) & + call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_3.f90 new file mode 100644 index 00000000000..a9f7ef7bc08 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_3.f90 @@ -0,0 +1,21 @@ +! Program to test WHERE on unknown size arrays +program where_3 + integer A(10, 2) + + A = 0 + call sub(A) + +contains + +subroutine sub(B) + integer, dimension(:, :) :: B + + B(1:5, 1) = 0 + B(6:10, 1) = 5 + where (B(:,1)>0) + B(:,1) = B(:,1) + 10 + endwhere + if (any (B .ne. reshape ((/0, 0, 0, 0, 0, 15, 15, 15, 15, 15, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/), (/10, 2/)))) call abort +end subroutine +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_4.f90 new file mode 100644 index 00000000000..104096b356a --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_4.f90 @@ -0,0 +1,13 @@ +! Tests WHERE statement with a data dependency +program where_4 + integer, dimension(5) :: a + integer, dimension(5) :: b + + a = (/1, 2, 3, 4, 5/) + b = (/1, 0, 1, 0, 1/) + + where (b .ne. 0) + a(:) = a(5:1:-1) + endwhere + if (any (a .ne. (/5, 2, 3, 4, 1/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_5.f90 new file mode 100644 index 00000000000..58d24ecbb30 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_5.f90 @@ -0,0 +1,13 @@ +! Tests WHERE satement with non-integer array in the mask expression +program where_5 + integer, dimension(5) :: a + real(kind=8), dimension(5) :: b + + a = (/1, 2, 3, 4, 5/) + b = (/1d0, 0d0, 1d0, 0d0, 1d0/) + + where (b .ne. 0d0) + a(:) = a(:) + 10 + endwhere + if (any (a .ne. (/11, 2, 13, 4, 15/))) call abort +end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_6.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_6.f90 new file mode 100644 index 00000000000..274598b8d77 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_6.f90 @@ -0,0 +1,23 @@ +! Program to test WHERE inside FORALL and the WHERE assignment need temporary +program where_6 + integer :: A(5,5) + + A(1,:) = (/1,0,0,0,0/) + A(2,:) = (/2,1,1,1,0/) + A(3,:) = (/1,2,2,0,2/) + A(4,:) = (/2,1,0,2,3/) + A(5,:) = (/1,0,0,0,0/) + + ! Where inside FORALL. + ! WHERE masks must be evaluated before executing the assignments + m=5 + forall (I=1:4) + where (A(I,:) .EQ. 0) + A(1:m,I) = A(1:m,I+1) + I + elsewhere (A(I,:) >2) + A(I,1:m) = 6 + endwhere + end forall + if (any (A .ne. reshape ((/1,2,6,2,1,0,1,2,1,2,0,1,2,5,0,0,1,6,2,0,0,0,2,& + 6,0/), (/5, 5/)))) call abort +end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/write_logical.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/write_logical.f90 new file mode 100644 index 00000000000..4e0060702f3 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/write_logical.f90 @@ -0,0 +1,23 @@ +! PR 14334, L edit descriptor does not work +! +! this test uses L1 and L4 to print TRUE and FALSE + logical true,false + character*10 b + true = .TRUE. + false = .FALSE. + b = '' + write (b, '(L1)') true + if (b(1:1) .ne. 'T') call abort + + b = '' + write (b, '(L1)') false + if (b(1:1) .ne. 'F') call abort + + b = '' + write(b, '(L4)') true + if (b(1:4) .ne. ' T') call abort + + b = '' + write(b, '(L4)') false + if (b(1:4) .ne. ' F') call abort + end diff --git a/gcc/testsuite/lib/fortran-torture.exp b/gcc/testsuite/lib/fortran-torture.exp new file mode 100644 index 00000000000..67b18ebc7ac --- /dev/null +++ b/gcc/testsuite/lib/fortran-torture.exp @@ -0,0 +1,344 @@ +# Copyright (C) 2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# Please email any bugs, comments, and/or additions to this file to +# the author. + +# This file was written by Steven Bosscher (s.bosscher@student.tudelft.nl) +# based on f-torture.exp, which was written by Rob Savoye. + +# The biggest change from g77 is that we always test all testcases with +# loop options, because it is much harder to figure out whether a testcase +# has loops if you have array syntax, like Fortran 95. In fact, the whole +# point of F95 is arrays, so loops show up in most testcases anyway. + + +# The default option list can be overridden by +# TORTURE_OPTIONS="{ { list1 } ... { listN } }" + +if ![info exists TORTURE_OPTIONS] { + set TORTURE_OPTIONS [list \ + { -O0 } { -O1 } { -O2 } \ + { -O2 -fomit-frame-pointer -finline-functions } \ + { -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ + { -O2 -fomit-frame-pointer -finline-functions -funroll-all-loops } \ + { -O2 -fno-repack-arrays } \ + { -O3 -g } \ + { -Os }] +} + + +# +# fortran-torture-compile -- compile a gfortran.fortran-torture testcase. +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc fortran-torture-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$srcdir/?" $src "" testcase + + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + verbose "Testing $testcase, $option" 1 + + # Run the compiler and get results in comp_output. + set options "" + lappend options "additional_flags=-w $option" + + set comp_output [gfortran_target_compile "$src" "$output" object $options]; + + # See if we got something bad. + set fatal_signal "*95*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + gfortran_fail $testcase "Got Signal 6, $option" + remote_file build delete $output + return + } + + if [string match "$fatal_signal 11" $comp_output] then { + gfortran_fail $testcase "Got Signal 11, $option" + remote_file build delete $output + return + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*95*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $output + return + } + + # Prune warnings we know are unwanted. + set comp_output [prune_warnings $comp_output] + + # Report if the testcase is not supported. + set unsupported_message [gfortran_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + remote_file build delete $output + return + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $comp_output "" comp_output + + # If any message remains, we fail. + if ![string match "" $comp_output] then { + gfortran_fail $testcase $option + remote_file build delete $output + return + } + + gfortran_pass $testcase $option + remote_file build delete $output +} + + +# +# fortran-torture-execute -- compile and execute a testcase. +# +# SRC is the full pathname of the testcase. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc fortran-torture-execute { src } { + global output + global srcdir tmpdir + global tool + global compiler_conditional_xfail_data + global TORTURE_OPTIONS + + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + # Setup the options for the testcase run. + set option_list $TORTURE_OPTIONS + set executable $tmpdir/[file tail [file rootname $src].x] + regsub "^$srcdir/?" $src "" testcase + + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + # Walk the list of options and copmile and run the testcase for all + # options that are not explicitly disabled by the .x script (if present). + foreach option $option_list { + + # Torture_{compile,execute}_xfail are set by the .x script. + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # Torture_execute_before_{compile,execute} can be set by the .x script. + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + # FIXME: We should make sure that the modules required by this testcase + # exist. If not, the testcase should XFAIL. + + # Compile the testcase. + remote_file build delete $executable + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=-w $option" + set comp_output [gfortran_target_compile "$src" "$executable" executable $options]; + + # See if we got something bad. + set fatal_signal "*95*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + gfortran_fail $testcase "Got Signal 6, $option" + remote_file build delete $executable + continue + } + + if [string match "$fatal_signal 11" $comp_output] then { + gfortran_fail $testcase "Got Signal 11, $option" + remote_file build delete $executable + continue + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*95*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + remote_file build delete $executable + continue + } + + # Prune warnings we know are unwanted. + set comp_output [prune_warnings $comp_output] + + # Report if the testcase is not supported. + set unsupported_message [gfortran_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + continue + } elseif ![file exists $executable] { + if ![is3way] { + fail "$testcase compilation, $option" + untested "$testcase execution, $option" + continue + } else { + # FIXME: since we can't test for the existance of a remote + # file without short of doing an remote file list, we assume + # that since we got no output, it must have compiled. + pass "$testcase compilation, $option" + } + } else { + pass "$testcase compilation, $option" + } + + # See if this source file uses INTEGER(KIND=8) types, if it does, and + # no_long_long is set, skip execution of the test. + # FIXME: We should also look for F95 style "_8" or select_int_kind() + # integers, but that is obviously much harder than just regexping this. + # So maybe we should just avoid those in testcases. + if [target_info exists no_long_long] then { + if [expr [search_for $src "integer\*8"] \ + +[search_for $src "integer *( *8 *)"] \ + +[search_for $src "integer *( *kind *= *8 *)"]] \ + then { + untested "$testcase execution, $option" + continue + } + } + + if [info exists torture_execute_xfail] { + setup_xfail $torture_execute_xfail + } + + if [info exists torture_eval_before_execute] { + set ignore_me [eval $torture_eval_before_execute] + } + + # Run the testcase, and analyse the output. + set result [gfortran_load "$executable" "" ""] + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $status == "pass" } { + remote_file build delete $executable + } + $status "$testcase execution, $option" + } +} + + +# +# search_for -- looks for a string match in a file +# +proc search_for { file pattern } { + set fd [open $file r] + while { [gets $fd cur_line]>=0 } { + set lower [string tolower $cur_line] + if [regexp "$pattern" $lower] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + + +# +# fortran-torture -- the fortran-torture testcase source file processor +# +# This runs compilation only tests (no execute tests). +# +# SRC is the full pathname of the testcase, or just a file name in which +# case we prepend $srcdir/$subdir. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc fortran-torture { args } { + global srcdir subdir + global compiler_conditional_xfail_data + global TORTURE_OPTIONS + + set src [lindex $args 0]; + if { [llength $args] > 1 } { + set options [lindex $args 1]; + } else { + set options "" + } + + # Prepend $srdir/$subdir if missing. + if ![string match "*/*" $src] { + set src "$srcdir/$subdir/$src" + } + + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + # loop through all the options + set option_list $TORTURE_OPTIONS + foreach option $option_list { + + # torture_compile_xfail is set by the .x script (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_compile is set by the .x script (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + fortran-torture-compile $src "$option $options" + } +} + diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp index 7977893cae6..803d609068f 100644 --- a/gcc/testsuite/lib/gcc-dg.exp +++ b/gcc/testsuite/lib/gcc-dg.exp @@ -18,6 +18,7 @@ load_lib dg.exp load_lib file-format.exp load_lib target-supports.exp load_lib scanasm.exp +load_lib scantree.exp load_lib prune.exp if ![info exists TORTURE_OPTIONS] { diff --git a/gcc/testsuite/lib/gfortran.exp b/gcc/testsuite/lib/gfortran.exp new file mode 100644 index 00000000000..483c3893a79 --- /dev/null +++ b/gcc/testsuite/lib/gfortran.exp @@ -0,0 +1,233 @@ +# Copyright (C) 2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# This file is just 'sed -e 's/77/fortran/g' \ +# -e 's/f2c/gfortran' g77.exp > gfortran.exp' +# +# with some minor modifications to make it work. + +# +# gfortran support library routines +# +load_lib prune.exp +load_lib gcc-defs.exp + +# +# GFORTRAN_UNDER_TEST is the compiler under test. +# + + +set gpp_compile_options "" + + +# +# gfortran_version -- extract and print the version number of the compiler +# + +proc gfortran_version { } { + global GFORTRAN_UNDER_TEST + + gfortran_init + + # ignore any arguments after the command + set compiler [lindex $GFORTRAN_UNDER_TEST 0] + + # verify that the compiler exists + if { [is_remote host] || [which $compiler] != 0 } then { + set tmp [remote_exec host "$compiler -v"] + set status [lindex $tmp 0]; + set output [lindex $tmp 1]; + regexp "version.*$" $output version + if { $status == 0 && [info exists version] } then { + if [is_remote host] { + clone_output "$compiler $version\n" + } else { + clone_output "[which $compiler] $version\n" + } + } else { + clone_output "Couldn't determine version of [which $compiler]\n" + } + } else { + # compiler does not exist (this should have already been detected) + warning "$compiler does not exist" + } +} + +# +# gfortran_link_flags -- provide new version of gfortran_link_flags +# (originally from libgloss.exp) which knows about the gcc tree structure +# + +proc gfortran_link_flags { paths } { + global rootme + global srcdir + global ld_library_path + global GFORTRAN_UNDER_TEST + + set gccpath ${paths} + set libio_dir "" + set flags "" + set ld_library_path "." + + if { $gccpath != "" } { + if [file exists "${gccpath}/libgfortran/.libs/libgfortran.a"] { + append flags "-L${gccpath}/libgfortran/.libs " + append ld_library_path ":${gccpath}/libgfortran/.libs" + } + if [file exists "${gccpath}/libgfortran/libgforbegin.a"] { + append flags "-L${gccpath}/libgfortran " + } + if [file exists "${gccpath}/libiberty/libiberty.a"] { + append flags "-L${gccpath}/libiberty " + } + append ld_library_path ":${rootme}" + set compiler [lindex $GFORTRAN_UNDER_TEST 0] + if { [is_remote host] == 0 && [which $compiler] != 0 } { + foreach i "[exec $compiler --print-multi-lib]" { + set mldir "" + regexp -- "\[a-z0-9=/\.-\]*;" $i mldir + set mldir [string trimright $mldir "\;@"] + if { "$mldir" == "." } { + continue + } + if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] == 1 } { + append ld_library_path ":${rootme}/${mldir}" + } + } + } + } + + # On IRIX 6, we have to set variables akin to LD_LIBRARY_PATH, but + # called LD_LIBRARYN32_PATH (for the N32 ABI) and LD_LIBRARY64_PATH + # (for the 64-bit ABI). The right way to do this would be to modify + # unix.exp -- but that's not an option since it's part of DejaGNU + # proper, so we do it here. + # The same applies to Darwin (DYLD_LIBRARY_PATH), Solaris 32 bit + # (LD_LIBRARY_PATH_32), Solaris 64 bit (LD_LIBRARY_PATH_64), and HP-UX + # (SHLIB_PATH). + # Doing this does cause trouble when testing cross-compilers. + if {![is_remote target]} { + global env; + if { [info exists env(LD_LIBRARY_PATH)] + && $env(LD_LIBRARY_PATH) != "" } { + append ld_library_path ":$env(LD_LIBRARY_PATH)"; + } + setenv LD_LIBRARY_PATH $ld_library_path + setenv SHLIB_PATH $ld_library_path + setenv LD_LIBRARYN32_PATH $ld_library_path + setenv LD_LIBRARY64_PATH $ld_library_path + setenv LD_LIBRARY_PATH_32 $ld_library_path + setenv LD_LIBRARY_PATH_64 $ld_library_path + setenv DYLD_LIBRARY_PATH $ld_library_path + } + + return "$flags" +} + +# +# gfortran_init -- called at the start of each subdir of tests +# + +proc gfortran_init { args } { + global subdir + global gpp_initialized + global base_dir + global tmpdir + global libdir + global gluefile wrap_flags; + global objdir srcdir + global ALWAYS_GFORTRANFLAGS + global TOOL_EXECUTABLE TOOL_OPTIONS + global GFORTRAN_UNDER_TEST + global TESTING_IN_BUILD_TREE + + if ![info exists GFORTRAN_UNDER_TEST] then { + if [info exists TOOL_EXECUTABLE] { + set GFORTRAN_UNDER_TEST $TOOL_EXECUTABLE; + } else { + if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { + set GFORTRAN_UNDER_TEST [transform gfortran] + } else { + set GFORTRAN_UNDER_TEST [findfile $base_dir/../gfortran "$base_dir/../gfortran -B$base_dir/../" [findfile $base_dir/gfortran "$base_dir/gfortran -B$base_dir/" [transform gfortran]]] + } + } + } + + if ![is_remote host] { + if { [which $GFORTRAN_UNDER_TEST] == 0 } then { + perror "GFORTRAN_UNDER_TEST ($GFORTRAN_UNDER_TEST) does not exist" + exit 1 + } + } + if ![info exists tmpdir] { + set tmpdir "/tmp" + } + + if [info exists gluefile] { + unset gluefile + } + + if { [target_info needs_status_wrapper] != "" } { + set gluefile ${tmpdir}/gfortran-testglue.o; + set result [build_wrapper $gluefile]; + if { $result != "" } { + set gluefile [lindex $result 0]; + set wrap_flags [lindex $result 1]; + } else { + unset gluefile + } + } + + set ALWAYS_GFORTRANFLAGS "" + + if ![is_remote host] { + if [info exists TOOL_OPTIONS] { + lappend ALWAYS_GFORTRANFLAGS "ldflags=[gfortran_link_flags [get_multilibs ${TOOL_OPTIONS}] ]"; + } else { + lappend ALWAYS_GFORTRANFLAGS "ldflags=[gfortran_link_flags [get_multilibs] ]"; + } + } + + if [info exists TOOL_OPTIONS] { + lappend ALWAYS_GFORTRANFLAGS "additional_flags=$TOOL_OPTIONS"; + } + + verbose -log "ALWAYS_GFORTRANFLAGS set to $ALWAYS_GFORTRANFLAGS" + + verbose "gfortran is initialized" 3 +} + +# +# gfortran_target_compile -- compile a source file +# + +proc gfortran_target_compile { source dest type options } { + global tmpdir; + global gluefile wrap_flags + global ALWAYS_GFORTRANFLAGS; + global GFORTRAN_UNDER_TEST; + + if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=${wrap_flags}" + } + + lappend options "compiler=$GFORTRAN_UNDER_TEST"; + + set options [concat "$ALWAYS_GFORTRANFLAGS" $options]; + + return [target_compile $source $dest $type $options] +} diff --git a/gcc/testsuite/lib/scantree.exp b/gcc/testsuite/lib/scantree.exp new file mode 100644 index 00000000000..76d1a59fb60 --- /dev/null +++ b/gcc/testsuite/lib/scantree.exp @@ -0,0 +1,243 @@ +# Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# Various utilities for scanning tree dump output, used by gcc-dg.exp and +# g++-dg.exp. +# +# This is largely borrowed from scanasm.exp. + +# Utility for scanning compiler result, invoked via dg-final. +# Call pass if pattern is present, otherwise fail. +# +# Argument 0 is the regexp to match. +# Argument 1 is the suffix for the tree dump file +# Argument 2 handles expected failures and the like +proc scan-tree-dump { args } { + if { [llength $args] < 2 } { + error "scan-tree-dump: too few arguments" + return + } + if { [llength $args] > 3 } { + error "scan-tree-dump: too many arguments" + return + } + if { [llength $args] >= 3 } { + switch [dg-process-target [lindex $args 2]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + # This assumes that we are two frames down from dg-test, and that + # it still stores the filename of the testcase in a local variable "name". + # A cleaner solution would require a new dejagnu release. + upvar 2 name testcase + + # This must match the rule in gcc-dg.exp. + set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]" + + set fd [open $output_file r] + set text [read $fd] + close $fd + + if [regexp -- [lindex $args 0] $text] { + pass "$testcase scan-tree-dump [lindex $args 0]" + } else { + fail "$testcase scan-tree-dump [lindex $args 0]" + } +} + +# Call pass if pattern is present given number of times, otherwise fail. +# Argument 0 is the regexp to match. +# Argument 1 is number of times the regexp must be found +# Argument 2 is the suffix for the tree dump file +# Argument 3 handles expected failures and the like +proc scan-tree-dump-times { args } { + if { [llength $args] < 3 } { + error "scan-tree-dump: too few arguments" + return + } + if { [llength $args] > 4 } { + error "scan-tree-dump: too many arguments" + return + } + if { [llength $args] >= 4 } { + switch [dg-process-target [lindex $args 3]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + # This assumes that we are two frames down from dg-test, and that + # it still stores the filename of the testcase in a local variable "name". + # A cleaner solution would require a new dejagnu release. + upvar 2 name testcase + + # This must match the rule in gcc-dg.exp. + set output_file "[glob [file tail $testcase].t??.[lindex $args 2]]" + + set fd [open $output_file r] + set text [read $fd] + close $fd + + if { [llength [regexp -inline -all -- [lindex $args 0] $text]] == [lindex $args 1]} { + pass "$testcase scan-tree-dump-times [lindex $args 0] [lindex $args 1]" + } else { + fail "$testcase scan-tree-dump-times [lindex $args 0] [lindex $args 1]" + } +} + +# Call pass if pattern is not present, otherwise fail. +# +# Argument 0 is the regexp to match. +# Argument 1 is the suffix for the tree dump file +# Argument 2 handles expected failures and the like +proc scan-tree-dump-not { args } { + if { [llength $args] < 2 } { + error "scan-tree-dump-not: too few arguments" + return + } + if { [llength $args] > 3 } { + error "scan-tree-dump-not: too many arguments" + return + } + if { [llength $args] >= 3 } { + switch [dg-process-target [lindex $args 2]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + upvar 2 name testcase + set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]" + + set fd [open $output_file r] + set text [read $fd] + close $fd + + if ![regexp -- [lindex $args 0] $text] { + pass "$testcase scan-tree-dump-not [lindex $args 0]" + } else { + fail "$testcase scan-tree-dump-not [lindex $args 0]" + } +} + +# Utility for scanning demangled compiler result, invoked via dg-final. +# Call pass if pattern is present, otherwise fail. +# +# Argument 0 is the regexp to match. +# Argument 1 is the suffix for the tree dump file +# Argument 2 handles expected failures and the like +proc scan-tree-dump-dem { args } { + global cxxfilt + global base_dir + + if { [llength $args] < 2 } { + error "scan-tree-dump-dem: too few arguments" + return + } + if { [llength $args] > 3 } { + error "scan-tree-dump-dem: too many arguments" + return + } + if { [llength $args] >= 3 } { + switch [dg-process-target [lindex $args 2]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + # Find c++filt like we find g++ in g++.exp. + if ![info exists cxxfilt] { + set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \ + $base_dir/../../binutils/cxxfilt \ + [findfile $base_dir/../c++filt $base_dir/../c++filt \ + [findfile $base_dir/c++filt $base_dir/c++filt \ + [transform c++filt]]]] + verbose -log "c++filt is $cxxfilt" + } + + upvar 2 name testcase + set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]" + + set fd [open "| $cxxfilt < $output_file" r] + set text [read $fd] + close $fd + + if [regexp -- [lindex $args 0] $text] { + pass "$testcase scan-tree-dump-dem [lindex $args 0]" + } else { + fail "$testcase scan-tree-dump-dem [lindex $args 0]" + } +} + +# Call pass if demangled pattern is not present, otherwise fail. +# +# Argument 0 is the regexp to match. +# Argument 1 is the suffix for the tree dump file +# Argument 2 handles expected failures and the like +proc scan-tree-dump-dem-not { args } { + global cxxfilt + global base_dir + + if { [llength $args] < 2 } { + error "scan-tree-dump-dem-not: too few arguments" + return + } + if { [llength $args] > 3 } { + error "scan-tree-dump-dem-not: too many arguments" + return + } + if { [llength $args] >= 3 } { + switch [dg-process-target [lindex $args 2]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + # Find c++filt like we find g++ in g++.exp. + if ![info exists cxxfilt] { + set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \ + $base_dir/../../binutils/cxxfilt \ + [findfile $base_dir/../c++filt $base_dir/../c++filt \ + [findfile $base_dir/c++filt $base_dir/c++filt \ + [transform c++filt]]]] + verbose -log "c++filt is $cxxfilt" + } + + upvar 2 name testcase + set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]" + + set fd [open "| $cxxfilt < $output_file" r] + set text [read $fd] + close $fd + + if ![regexp -- [lindex $args 0] $text] { + pass "$testcase scan-tree-dump-dem-not [lindex $args 0]" + } else { + fail "$testcase scan-tree-dump-dem-not [lindex $args 0]" + } +} diff --git a/gcc/testsuite/treelang/compile/compile.exp b/gcc/testsuite/treelang/compile/compile.exp deleted file mode 100644 index 836c3251099..00000000000 --- a/gcc/testsuite/treelang/compile/compile.exp +++ /dev/null @@ -1,31 +0,0 @@ -# Tests for treelang; run from gcc/treelang/Make-lang.in => gcc/Makefile - -# Copyright (C) 2004 by The Free Software Foundation - -# This program 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 2, or (at your option) any -# later version. -# -# This program 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 program; if not, write to the Free Software -# Foundation, 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. -# -# In other words, you are welcome to use, share and improve this program. -# You are forbidden to forbid anyone else to use, share and improve -# what you give them. Help stamp out software-hoarding! - -# Treelang tests that only need to compile. - -# Load support procs. -load_lib treelang-dg.exp - -dg-init -dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.tree]] "" "" -dg-finish diff --git a/gcc/testsuite/treelang/compile/tabs.tree b/gcc/testsuite/treelang/compile/tabs.tree deleted file mode 100644 index 6294c15c49a..00000000000 --- a/gcc/testsuite/treelang/compile/tabs.tree +++ /dev/null @@ -1,11 +0,0 @@ -// { dg-do compile } -external_definition int main(int argc); - -main { - automatic int v1; - automatic int v2; - v1 = argc; - v2 = 3; - - return v2; -} |