diff options
Diffstat (limited to 'gcc/testsuite')
48 files changed, 1288 insertions, 515 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d4a5c9cbf5a..b8b9b94468d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,111 @@ +2012-01-07 Jan Hubicka <jh@suse.cz> + + PR tree-optimize/51694 + * gcc.c-torture/compile/pr51694.c: new testcase. + +2012-01-07 Jan Hubicka <jh@suse.cz> + + PR tree-optimization/51600 + * g++.dg/torture/pr51600.C: New testcase. + +2012-01-07 John David Anglin <dave.anglin@nrc-cnrc.gc.ca> + + PR gcov-profile/51715 + PR gcov-profile/51717 + * gcc.misc-tests/gcov-13.c: Skip on 32-bit hppa*-*-hpux*. + * gcc.misc-tests/gcov-14.c: Likewise. + +2012-01-06 Jason Merrill <jason@redhat.com> + + * g++.dg/parse/new5.C: New. + +2012-01-06 Patrick Marlier <patrick.marlier@gmail.com> + + PR testsuite/51655 + * c-c++-common/tm/memcpy-1.c: Declare memcpy instead of + including <string.h>. + +2012-01-06 Jason Merrill <jason@redhat.com> + + * g++.dg/abi/mangle51.C: New. + * g++.dg/abi/mangle52.C: New. + * g++.dg/abi/mangle53.C: New. + * g++.dg/abi/mangle54.C: New. + * g++.dg/abi/mangle55.C: New. + * g++.dg/abi/mangle56.C: New. + * g++.dg/abi/mangle57.C: New. + * g++.dg/abi/mangle58.C: New. + * g++.dg/abi/mangle59.C: New. + * g++.dg/cpp0x/trailing3.C: Update mangling. + * g++.dg/cpp0x/variadic111.C: Update mangling. + * g++.dg/cpp0x/variadic4.C: Update mangling. + * g++.dg/cpp0x/variadic42.C: Pass -fabi-version=5. + * g++.dg/template/nontype22.C: Works now. + * g++.dg/template/pr35240.C: Works now. + + * g++.dg/cpp0x/error7.C: New. + +2012-01-06 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/deallocate_stat_2.f90: New. + * coarray/allocate_errgmsg.f90: New. + * gfortran.dg/coarray_lib_alloc_1.f90: New. + * gfortran.dg/coarray_lib_alloc_2.f90: New. + * coarray/subobject_1.f90: Fix for num_images > 1. + * gfortran.dg/deallocate_stat.f90: Update due to changed + stat= handling. + +2012-01-06 Andrew Stubbs <ams@codesourcery.com> + + * gcc.target/arm/headmerge-2.c: Adjust scan pattern. + +2012-01-06 Eric Botcazou <ebotcazou@adacore.com> + + * ada/acats/overflow.lst: Add cb20004. + +2012-01-05 Dodji Seketeli <dodji@redhat.com> + + PR c++/51541 + * g++.dg/cpp0x/alias-decl-18.C: New test. + +2012-01-05 Eric Botcazou <ebotcazou@adacore.com> + + * gcc.c-torture/execute/20120104-1.c: New test. + +2012-01-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/PR48946 + * gfortran.dg/typebound_operator_9.f03: This is now a copy of + the old typebound_operator_8.f03. + * gfortran.dg/typebound_operator_8.f03: New version of + typebound_operator_7.f03 with 'u' a derived type instead of a + class object. + +2012-01-05 Richard Guenther <rguenther@suse.de> + + * g++.dg/torture/pr49309.C: Skip for -flto. + +2012-01-05 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/51761 + * gcc.c-torture/compile/pr51761.c: New test. + +2012-01-05 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/51760 + * gcc.dg/torture/pr51760.c: New testcase. + +2012-01-05 Aldy Hernandez <aldyh@redhat.com> + + PR middle-end/51472 + * gcc.dg/tm/memopt-6.c: Adjust regexp. + +2012-01-05 Richard Guenther <rguenther@suse.de> + + PR lto/41576 + * gfortran.dg/lto/pr41576_0.f90: New testcase. + * gfortran.dg/lto/pr41576_1.f90: Likewise. + 2012-01-04 Jakub Jelinek <jakub@redhat.com> PR debug/51695 diff --git a/gcc/testsuite/ada/acats/overflow.lst b/gcc/testsuite/ada/acats/overflow.lst index 3685a4d809f..fb76ef17705 100644 --- a/gcc/testsuite/ada/acats/overflow.lst +++ b/gcc/testsuite/ada/acats/overflow.lst @@ -14,3 +14,4 @@ c46014a c460008 c460011 c4a012b +cb20004 diff --git a/gcc/testsuite/c-c++-common/pr51768.c b/gcc/testsuite/c-c++-common/pr51768.c new file mode 100644 index 00000000000..082594ccad7 --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr51768.c @@ -0,0 +1,25 @@ +/* PR middle-end/51768 */ +/* { dg-do compile } */ +/* { dg-options "" } */ + +void +foo (void) +{ + asm goto ("" : : : : lab, lab, lab2, lab); /* { dg-error "duplicate asm operand name" } */ +lab:; +lab2:; +} + +void +bar (void) +{ + asm goto ("" : : [lab] "i" (0) : : lab); /* { dg-error "duplicate asm operand name" } */ +lab:; +} + +void +baz (void) +{ + int x; + asm ("" : [lab] "=r" (x) : [lab] "r" (x)); /* { dg-error "duplicate asm operand name" } */ +} diff --git a/gcc/testsuite/c-c++-common/tm/memcpy-1.c b/gcc/testsuite/c-c++-common/tm/memcpy-1.c index fa841b26164..873e14bb1bc 100644 --- a/gcc/testsuite/c-c++-common/tm/memcpy-1.c +++ b/gcc/testsuite/c-c++-common/tm/memcpy-1.c @@ -1,6 +1,10 @@ /* { dg-do compile } */ /* { dg-options "-fgnu-tm" } */ -#include <string.h> +typedef __SIZE_TYPE__ size_t; +#ifdef __cplusplus +extern "C" +#endif +void *memcpy (void *__restrict, const void *__restrict, size_t); __attribute__((transaction_safe)) void *wmemcpy(void *dest, const void *src, size_t n) diff --git a/gcc/testsuite/g++.dg/abi/mangle51.C b/gcc/testsuite/g++.dg/abi/mangle51.C new file mode 100644 index 00000000000..4992f1a327c --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle51.C @@ -0,0 +1,27 @@ +// { dg-options "-std=c++0x -fabi-version=0" } + +void* operator new (__SIZE_TYPE__, void *p) { return p; } +int i; + +template <unsigned int> struct helper {}; +// { dg-final { scan-assembler "_Z6check1IiEvP6helperIXsznw_T_EEE" } } +template <class T> void check1( helper<sizeof(new T)> * ) { } +// { dg-final { scan-assembler "_Z6check2IiEvP6helperIXszgsnw_T_piEEE" } } +template <class T> void check2( helper<sizeof(::new T())> * ) { } +// { dg-final { scan-assembler "_Z6check3IiEvP6helperIXsznwadL_Z1iE_T_piLi1EEEE" } } +template <class T> void check3( helper<sizeof(new (&i) T(1))> * ) { } +// { dg-final { scan-assembler "_Z7check3aIiEvP6helperIXsznw_T_ilLi1EEEE" } } +template <class T> void check3a( helper<sizeof(new T{1})> * ) { } +// { dg-final { scan-assembler "_Z6check4IiEvP6helperIXszna_A1_T_EEE" } } +template <class T> void check4( helper<sizeof(new T[1])> * ) { } +// { dg-final { scan-assembler "_Z6check5IiEvP6helperIXszna_A1_T_piEEE" } } +template <class T> void check5( helper<sizeof(new T[1]())> * ) { } +int main() +{ + check1<int>(0); + check2<int>(0); + check3<int>(0); + check3a<int>(0); + check4<int>(0); + check5<int>(0); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle52.C b/gcc/testsuite/g++.dg/abi/mangle52.C new file mode 100644 index 00000000000..2c463415f1f --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle52.C @@ -0,0 +1,21 @@ +// { dg-options "-fabi-version=0" } + +template <unsigned int> struct helper {}; +// { dg-final { scan-assembler "_Z6check1IiEvP6helperIXszscT_Li1EEE" } } +template <class T> void check1( helper<sizeof(static_cast<T>(1))> * ) { } +// { dg-final { scan-assembler "_Z6check2IiXadL_Z1iEEEvP6helperIXszccPT_T0_EE" } } +template <class T, T* p> void check2( helper<sizeof(const_cast<T*>(p))> * ) { } +// { dg-final { scan-assembler "_Z6check3IiEvP6helperIXszrcPT_Li0EEE" } } +template <class T> void check3( helper<sizeof(reinterpret_cast<T*>(0))> * ) { } +// { dg-final { scan-assembler "_Z6check4I1AXadL_Z1aEEEvP6helperIXszdcPT_T0_EE" } } +template <class T, T* p> void check4( helper<sizeof(dynamic_cast<T*>(p))> * ) { } + +struct A{} a; +int i; +int main() +{ + check1<int>(0); + check2<int,&i>(0); + check3<int>(0); + check4<A,&a>(0); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle53.C b/gcc/testsuite/g++.dg/abi/mangle53.C new file mode 100644 index 00000000000..b279182d8c4 --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle53.C @@ -0,0 +1,13 @@ +// { dg-options "-std=c++0x" } + +bool b; +// { dg-final { scan-assembler "_Z1fIiEDTquL_Z1bEfp_twLi42EET_" } } +template <class T> auto f (T t) -> decltype(b?t:throw 42) { return 0; } +// { dg-final { scan-assembler "_Z2f2IiEDTquL_Z1bEfp_trET_" } } +template <class T> auto f2 (T t) -> decltype(b?t:throw) { return 0; } + +int main() +{ + f(0); + f2(0); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle54.C b/gcc/testsuite/g++.dg/abi/mangle54.C new file mode 100644 index 00000000000..ea98df17d36 --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle54.C @@ -0,0 +1,19 @@ +// { dg-options "-std=c++0x -fabi-version=0" } + +int i; +// { dg-final { scan-assembler "_Z2f1IiEDTppfp_ET_" } } +template <class T> auto f1 (T t) -> decltype(t++) { return i; } +// { dg-final { scan-assembler "_Z2f2IiEDTpp_fp_ET_" } } +template <class T> auto f2 (T t) -> decltype(++t) { return i; } +// { dg-final { scan-assembler "_Z2f3IiEDTmmfp_ET_" } } +template <class T> auto f3 (T t) -> decltype(t--) { return i; } +// { dg-final { scan-assembler "_Z2f4IiEDTmm_fp_ET_" } } +template <class T> auto f4 (T t) -> decltype(--t) { return i; } + +int main() +{ + f1(0); + f2(0); + f3(0); + f4(0); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle55.C b/gcc/testsuite/g++.dg/abi/mangle55.C new file mode 100644 index 00000000000..72caadcc24d --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle55.C @@ -0,0 +1,14 @@ +// { dg-options "-std=c++0x" } + +struct A { int i; }; +// { dg-final { scan-assembler "_Z2f1Ii1AEDTdsfp_fp0_ET0_MS2_T_" } } +template <class T, class U> auto f1 (U u, T U::* p) -> decltype(u.*p) { return u.*p; } +// { dg-final { scan-assembler "_Z2f2Ii1AEDTpmfp_fp0_EPT0_MS2_T_" } } +template <class T, class U> auto f2 (U* u, T U::* p) -> decltype(u->*p) { return u->*p; } + +int main() +{ + A a = {}; + f1(a, &A::i); + f2(&a, &A::i); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle56.C b/gcc/testsuite/g++.dg/abi/mangle56.C new file mode 100644 index 00000000000..0fd270169d6 --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle56.C @@ -0,0 +1,13 @@ +// { dg-options "-std=c++0x" } + +template <class T> T g(T t1, T t2) { return t2; } +// { dg-final { scan-assembler "_Z2f1IiEDTcl1gfp_ilEEET_" } } +template <class T> auto f1 (T t) -> decltype(g(t,{})) { return g(t,{}); } +// { dg-final { scan-assembler "_Z2f2IiEDTcl1gfp_tlT_EEES0_" } } +template <class T> auto f2 (T t) -> decltype(g(t,T{})) { return g(t,T{}); } + +int main() +{ + f1(0); + f2(0); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle57.C b/gcc/testsuite/g++.dg/abi/mangle57.C new file mode 100644 index 00000000000..3d9d81e55ba --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle57.C @@ -0,0 +1,16 @@ +// { dg-options "-std=c++0x -fabi-version=0" } + +template<typename T> int cmp1(T a, T b); +int cmp2(char a, char b); +template<typename T, int (*cmp)(T, T)> struct A { }; +// { dg-final { scan-assembler "_Z1fIcEvR1AIT_X4cmp1EE" } } +template <typename T> void f (A<T,cmp1> &); +// { dg-final { scan-assembler "_Z1fIcEvR1AIT_L_Z4cmp2ccEE" } } +template <typename T> void f (A<T,cmp2> &); +void g() +{ + A<char,cmp1> a; + f(a); + A<char,cmp2> a2; + f(a2); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle58.C b/gcc/testsuite/g++.dg/abi/mangle58.C new file mode 100644 index 00000000000..14e5543d9f2 --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle58.C @@ -0,0 +1,19 @@ +// { dg-options "-std=c++0x -fabi-version=0" } + +template<typename T, int (*cmp)(T, T)> struct A { }; +struct B { + template<typename T> static int cmp1(T a, T b); + static int cmp2(char a, char b); + // { dg-final { scan-assembler "_ZN1B1fIcEEvR1AIT_X4cmp1EE" } } + template <typename T> static void f (A<T,cmp1> &); + // { dg-final { scan-assembler "_ZN1B1fIcEEvR1AIT_L_ZNS_4cmp2EccEE" } } + template <typename T> static void f (A<T,cmp2> &); +}; + +void g() +{ + A<char,B::cmp1> a; + B::f(a); + A<char,B::cmp2> a2; + B::f(a2); +} diff --git a/gcc/testsuite/g++.dg/abi/mangle59.C b/gcc/testsuite/g++.dg/abi/mangle59.C new file mode 100644 index 00000000000..3c88ec87486 --- /dev/null +++ b/gcc/testsuite/g++.dg/abi/mangle59.C @@ -0,0 +1,19 @@ +// { dg-options "-std=c++0x -fabi-version=0" } + +// { dg-final { scan-assembler "_Z1fIiEDTcmdlfp_psfp_EPT_" } } +template <class T> auto f (T* p) -> decltype(delete p, +p) { return p; } +// { dg-final { scan-assembler "_Z1gIiEDTcmgsdlfp_psfp_EPT_" } } +template <class T> auto g (T* p) -> decltype(::delete p, +p) { return p; } +// { dg-final { scan-assembler "_Z1hIiEDTcmdafp_psfp_EPT_" } } +template <class T> auto h (T* p) -> decltype(delete[] p, +p) { return p; } +// { dg-final { scan-assembler "_Z1iIiEDTcmgsdafp_psfp_EPT_" } } +template <class T> auto i (T* p) -> decltype(::delete[] p, +p) { return p; } + +int main() +{ + int x; + f(&x); + g(&x); + h(&x); + i(&x); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/alias-decl-18.C b/gcc/testsuite/g++.dg/cpp0x/alias-decl-18.C new file mode 100644 index 00000000000..ba655613117 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/alias-decl-18.C @@ -0,0 +1,9 @@ +// Origin: PR c++/51541 +// { dg-options -std=c++11 } + +template<typename Z> using ::T = void(int n); // { dg-error "" } +template<typename Z> using operator int = void(int n); // { dg-error "" } +template<typename Z> using typename U = void; // { dg-error "" } +template<typename Z> using typename ::V = void(int n); // { dg-error "" } +template<typename Z> using typename ::operator bool = void(int n); // { dg-error "" } +using foo __attribute__((aligned(4)) = int; // { dg-error "" } diff --git a/gcc/testsuite/g++.dg/cpp0x/error7.C b/gcc/testsuite/g++.dg/cpp0x/error7.C new file mode 100644 index 00000000000..0dfbf9f0406 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/error7.C @@ -0,0 +1,10 @@ +// Test for printing the type of T{} in error messages. +// { dg-options -std=c++0x } + +template <class T, T t> struct A { }; +template <class T> A<T,T{}> f(T t); // { dg-message "T{}" } + +int main() +{ + f(); // { dg-error "no match" } +} diff --git a/gcc/testsuite/g++.dg/cpp0x/trailing3.C b/gcc/testsuite/g++.dg/cpp0x/trailing3.C index 82d36f0d0d2..1c64f45731a 100644 --- a/gcc/testsuite/g++.dg/cpp0x/trailing3.C +++ b/gcc/testsuite/g++.dg/cpp0x/trailing3.C @@ -1,5 +1,5 @@ // More auto/decltype mangling tests. -// { dg-options "-std=c++0x" } +// { dg-options "-std=c++0x -fabi-version=0" } template <class T> struct B @@ -58,6 +58,6 @@ int main() A<int>().h(1); // { dg-final { scan-assembler "_ZN1AIiE1jIiEEDTplfp_clL_Z1xvEEET_" } } A<int>().j(1); - // { dg-final { scan-assembler "_Z1gIIidEEDTcl1fspplfp_Li1EEEDpT_" } } + // { dg-final { scan-assembler "_Z1gIJidEEDTcl1fspplfp_Li1EEEDpT_" } } g(42, 1.0); } diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic111.C b/gcc/testsuite/g++.dg/cpp0x/variadic111.C index 378162e162d..cb94ce69755 100644 --- a/gcc/testsuite/g++.dg/cpp0x/variadic111.C +++ b/gcc/testsuite/g++.dg/cpp0x/variadic111.C @@ -1,5 +1,5 @@ // PR c++/48424 -// { dg-options -std=c++0x } +// { dg-options "-std=c++0x -fabi-version=0" } template<typename... Args1> struct S @@ -16,4 +16,4 @@ int main() s.f(1,2.0,false,'a'); } -// { dg-final { scan-assembler "_ZN1SIIidEE1fIIbcEEEvidDpOT_" } } +// { dg-final { scan-assembler "_ZN1SIJidEE1fIJbcEEEvidDpOT_" } } diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic4.C b/gcc/testsuite/g++.dg/cpp0x/variadic4.C index 9257a92d5b9..1bdad3256fb 100644 --- a/gcc/testsuite/g++.dg/cpp0x/variadic4.C +++ b/gcc/testsuite/g++.dg/cpp0x/variadic4.C @@ -1,4 +1,4 @@ -// { dg-options "-std=gnu++0x" } +// { dg-options "-std=gnu++0x -fabi-version=0" } // { dg-do compile } template<typename... Args> class tuple {}; @@ -9,7 +9,7 @@ void f_two(tuple<int, float>) {} void f_nested(tuple<int, tuple<double, char>, float>) { } -// { dg-final { scan-assembler "_Z6f_none5tupleIIEE" } } -// { dg-final { scan-assembler "_Z5f_one5tupleIIiEE" } } -// { dg-final { scan-assembler "_Z5f_two5tupleIIifEE" } } -// { dg-final { scan-assembler "_Z8f_nested5tupleIIiS_IIdcEEfEE" } } +// { dg-final { scan-assembler "_Z6f_none5tupleIJEE" } } +// { dg-final { scan-assembler "_Z5f_one5tupleIJiEE" } } +// { dg-final { scan-assembler "_Z5f_two5tupleIJifEE" } } +// { dg-final { scan-assembler "_Z8f_nested5tupleIJiS_IJdcEEfEE" } } diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic42.C b/gcc/testsuite/g++.dg/cpp0x/variadic42.C index 47d9b66da58..3ec68e8b1ff 100644 --- a/gcc/testsuite/g++.dg/cpp0x/variadic42.C +++ b/gcc/testsuite/g++.dg/cpp0x/variadic42.C @@ -1,4 +1,4 @@ -// { dg-options "-std=gnu++0x" } +// { dg-options "-std=gnu++0x -fabi-version=5" } // { dg-do compile } template<typename... Args> void f(Args...) { } diff --git a/gcc/testsuite/g++.dg/parse/new5.C b/gcc/testsuite/g++.dg/parse/new5.C new file mode 100644 index 00000000000..83937c6e9c1 --- /dev/null +++ b/gcc/testsuite/g++.dg/parse/new5.C @@ -0,0 +1,4 @@ +// PR c++/47450 + +struct A { }; +A* ap = new(struct: A { }); // { dg-error "types may not be defined" } diff --git a/gcc/testsuite/g++.dg/template/nontype22.C b/gcc/testsuite/g++.dg/template/nontype22.C index f2c8c46e9fc..44d8479af29 100644 --- a/gcc/testsuite/g++.dg/template/nontype22.C +++ b/gcc/testsuite/g++.dg/template/nontype22.C @@ -3,7 +3,7 @@ template<typename T> int cmp1(T a, T b); template<typename T, int (*cmp)(T, T) = cmp1> struct A { }; -template <typename T> void f (A<T> &); // { dg-bogus "" "" { xfail *-*-* } } +template <typename T> void f (A<T> &); void g() { A<char> a; diff --git a/gcc/testsuite/g++.dg/template/pr35240.C b/gcc/testsuite/g++.dg/template/pr35240.C index 88e25050fda..5b945511768 100644 --- a/gcc/testsuite/g++.dg/template/pr35240.C +++ b/gcc/testsuite/g++.dg/template/pr35240.C @@ -1,12 +1,11 @@ // PR c++/35240 // { dg-do compile } - template<int> struct A {}; -template<int N> A<sizeof(new int[N][N])> foo(); // { dg-message "unimplemented" } +template<int N> A<sizeof(new int[N][N])> foo(); void bar() { - foo<1>(); // { dg-message "required" } + foo<1>(); } diff --git a/gcc/testsuite/g++.dg/torture/pr49309.C b/gcc/testsuite/g++.dg/torture/pr49309.C index a3453779250..f96967ddd34 100644 --- a/gcc/testsuite/g++.dg/torture/pr49309.C +++ b/gcc/testsuite/g++.dg/torture/pr49309.C @@ -1,5 +1,6 @@ // PR tree-optimization/49309 // { dg-do compile } +// { dg-skip-if "" { *-*-* } { "-flto" } { "" } } // { dg-options "-fpreprocessed -fmudflap" } struct A diff --git a/gcc/testsuite/g++.dg/torture/pr51600.C b/gcc/testsuite/g++.dg/torture/pr51600.C new file mode 100644 index 00000000000..61803607762 --- /dev/null +++ b/gcc/testsuite/g++.dg/torture/pr51600.C @@ -0,0 +1,16 @@ +template<class T> inline T min(T a, T b) { return a < b ? a : b; } +double cornerbound(double *P, double (*m)(double, double)) +{ + double b=m(P[0],P[3]); + return m(b,P[12]); +} +void bound(double *P, double (*m)(double, double), double b) +{ + m(b,cornerbound(P,m)); +} +void bounds(double fuzz, unsigned maxdepth) +{ + double Px[]={}; + double bx=Px[0]; + bound(Px,min,bx); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr49710.c b/gcc/testsuite/gcc.c-torture/compile/pr49710.c new file mode 100644 index 00000000000..2a6e331db8d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr49710.c @@ -0,0 +1,35 @@ +int a, b, c, d; + +static void +foo (int *x) +{ + c = 0; + while (1) + { + if (*x) +break; + while (b) +for (; c; c = 0); + for (d = 18; d != 18; d++) +if (c) + { + foo (x); + return; + } + } +} + +static void +bar () +{ + foo (0); + foo (0); + for (;;) + ; +} + +baz () +{ + for (; a;) + bar (); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr51694.c b/gcc/testsuite/gcc.c-torture/compile/pr51694.c new file mode 100644 index 00000000000..579a2434d82 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr51694.c @@ -0,0 +1,14 @@ +void +foo (x, fn) + void (*fn) (); +{ + int a = baz ((void *) 0, x); + (*fn) (x, 0); +} + +void +bar (void) +{ + void *x = 0; + foo (x); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr51761.c b/gcc/testsuite/gcc.c-torture/compile/pr51761.c new file mode 100644 index 00000000000..68911c84ce1 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr51761.c @@ -0,0 +1,10 @@ +/* PR middle-end/51761 */ + +struct S { unsigned int len; }; +struct S foo (struct S); + +struct S +bar (struct S x) +{ + return ({ struct S a = x; foo (a); }); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr51767.c b/gcc/testsuite/gcc.c-torture/compile/pr51767.c new file mode 100644 index 00000000000..62a192d660d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr51767.c @@ -0,0 +1,23 @@ +/* PR rtl-optimization/51767 */ + +extern void fn1 (void), fn2 (void); + +static inline __attribute__((always_inline)) int +foo (int *x, long y) +{ + asm goto ("" : : "r" (x), "r" (y) : "memory" : lab); + return 0; +lab: + return 1; +} + +void +bar (int *x) +{ + if (foo (x, 23)) + fn1 (); + else + fn2 (); + + foo (x, 2); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20120105-1.c b/gcc/testsuite/gcc.c-torture/execute/20120105-1.c new file mode 100644 index 00000000000..115ba1509d4 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20120105-1.c @@ -0,0 +1,24 @@ +struct __attribute__((packed)) S +{ + int a, b, c; +}; + +static int __attribute__ ((noinline,noclone)) +extract(const char *p) +{ + struct S s; + __builtin_memcpy (&s, p, sizeof(struct S)); + return s.a; +} + +volatile int i; + +int main (void) +{ + char p[sizeof(struct S) + 1]; + + __builtin_memset (p, 0, sizeof(struct S) + 1); + i = extract (p + 1); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/pr51762.c b/gcc/testsuite/gcc.dg/pr51762.c new file mode 100644 index 00000000000..9c59f338c7e --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr51762.c @@ -0,0 +1,19 @@ +/* PR debug/51762 */ +/* { dg-do compile } */ +/* { dg-options "-g -Os -fomit-frame-pointer -fno-asynchronous-unwind-tables" } */ + +void noret (void) __attribute__ ((noreturn)); +int bar (void); +void baz (const char *); +static int v = -1; + +void +foo (void) +{ + if (bar () && v == -1) + { + baz ("baz"); + noret (); + } + noret (); +} diff --git a/gcc/testsuite/gcc.dg/tm/memopt-6.c b/gcc/testsuite/gcc.dg/tm/memopt-6.c index 496ce2dd3e8..810a5595db1 100644 --- a/gcc/testsuite/gcc.dg/tm/memopt-6.c +++ b/gcc/testsuite/gcc.dg/tm/memopt-6.c @@ -17,5 +17,5 @@ int f() return lala.x[i]; } -/* { dg-final { scan-tree-dump-times "memmoveRtWt \\\(&lala, &lacopy" 1 "tmedge" } } */ +/* { dg-final { scan-tree-dump-times "memmoveRtWt \\\(.*, &lacopy" 1 "tmedge" } } */ /* { dg-final { cleanup-tree-dump "tmedge" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/pr51760.c b/gcc/testsuite/gcc.dg/torture/pr51760.c new file mode 100644 index 00000000000..ebff2c93043 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr51760.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ + +extern inline __attribute__ ((always_inline)) void * +memmove (void *dest, const void *src, __SIZE_TYPE__ len) +{ + return __builtin___memmove_chk (dest, src, len, + __builtin_object_size (dest, 0)); +} + +void +foo (void) +{ + char a[64], *b; + for (;;) + { + memmove (a, b, 0); + b = a; + } +} diff --git a/gcc/testsuite/gcc.dg/tree-prof/pr44777.c b/gcc/testsuite/gcc.dg/tree-prof/pr44777.c new file mode 100644 index 00000000000..1c4da7f5f7d --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-prof/pr44777.c @@ -0,0 +1,43 @@ +/* PR middle-end/44777 */ +/* { dg-options "-O0" } */ +/* A variant of gcc.c-torture/execute/comp-goto-2.c. */ + +extern void abort (void); +extern void exit (int); + +#ifdef STACK_SIZE +#define DEPTH ((STACK_SIZE) / 512 + 1) +#else +#define DEPTH 1000 +#endif + +#if ! defined (NO_LABEL_VALUES) && !defined (NO_TRAMPOLINES) +int +x (int a) +{ + __label__ xlab; + void y (int a) + { + void *x = &&llab; + if (a==-1) + goto *x; + if (a==0) + goto xlab; + llab: + y (a-1); + } + y (a); + xlab:; + return a; +} +#endif + +int +main () +{ +#if ! defined (NO_LABEL_VALUES) && !defined (NO_TRAMPOLINES) + if (x (DEPTH) != DEPTH) + abort (); +#endif + exit (0); +} diff --git a/gcc/testsuite/gcc.misc-tests/gcov-13.c b/gcc/testsuite/gcc.misc-tests/gcov-13.c index fa9680b2544..e26f76be57b 100644 --- a/gcc/testsuite/gcc.misc-tests/gcov-13.c +++ b/gcc/testsuite/gcc.misc-tests/gcov-13.c @@ -4,6 +4,7 @@ /* { dg-require-weak "" } */ /* { dg-do run { target native } } */ /* { dg-additional-sources "gcovpart-13b.c" } */ +/* { dg-skip-if "weak ellision not supported" { { hppa*-*-hpux* } && { ! hppa*64*-*-* } } { "*" } { "" } } */ int __attribute__ ((weak)) weak () { diff --git a/gcc/testsuite/gcc.misc-tests/gcov-14.c b/gcc/testsuite/gcc.misc-tests/gcov-14.c index 9e16cee52cb..9599e0bd126 100644 --- a/gcc/testsuite/gcc.misc-tests/gcov-14.c +++ b/gcc/testsuite/gcc.misc-tests/gcov-14.c @@ -5,6 +5,7 @@ /* { dg-additional-options "-flat_namespace -undefined suppress" { target *-*-darwin* } } */ /* { dg-require-weak "" } */ /* { dg-do run { target native } } */ +/* { dg-skip-if "undefined weak not supported" { { hppa*-*-hpux* } && { ! hppa*64*-*-* } } { "*" } { "" } } */ extern int __attribute__ ((weak)) Foo (); diff --git a/gcc/testsuite/gcc.target/arm/headmerge-2.c b/gcc/testsuite/gcc.target/arm/headmerge-2.c index 36637a64eb3..17d8e9365c5 100644 --- a/gcc/testsuite/gcc.target/arm/headmerge-2.c +++ b/gcc/testsuite/gcc.target/arm/headmerge-2.c @@ -1,6 +1,6 @@ /* { dg-do compile } */ /* { dg-options "-O2" } */ -/* { dg-final { scan-assembler-times "120" 1 } } */ +/* { dg-final { scan-assembler-times "120\n" 1 } } */ extern void foo1 (int); extern void foo2 (int); diff --git a/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90 b/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90 new file mode 100644 index 00000000000..e5a19543742 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! +! Check handling of errmsg. +! +implicit none +integer, allocatable :: a[:], b(:)[:], c, d(:) +integer :: stat +character(len=300) :: str + +allocate(a[*], b(1)[*], c, d(2), stat=stat) + +str = repeat('X', len(str)) +allocate(a[*], stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to allocate an allocated object") & + call abort () + +str = repeat('Y', len(str)) +allocate(b(2)[*], stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to allocate an allocated object") & + call abort () + +str = repeat('Q', len(str)) +allocate(c, stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to allocate an allocated object") & + call abort () + +str = repeat('P', len(str)) +allocate(d(3), stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to allocate an allocated object") & + call abort () + +end diff --git a/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90 b/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90 index 02536866b4d..028c24a8e65 100644 --- a/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90 @@ -24,20 +24,20 @@ b%a%i = 7 if (b%a%i /= 7) call abort if (any (lcobound(b%a) /= (/ lb /))) call abort - if (ucobound(b%a, dim=1) /= this_image() + lb - 1) call abort + if (ucobound(b%a, dim=1) /= num_images() + lb - 1) call abort if (any (lcobound(b%a%i) /= (/ lb /))) call abort - if (ucobound(b%a%i, dim=1) /= this_image() + lb - 1) call abort + if (ucobound(b%a%i, dim=1) /= num_images() + lb - 1) call abort allocate(c%a(la)[lc:*]) c%a%i = init if (any(c%a%i /= init)) call abort if (any (lcobound(c%a) /= (/ lc /))) call abort - if (ucobound(c%a, dim=1) /= this_image() + lc - 1) call abort + if (ucobound(c%a, dim=1) /= num_images() + lc - 1) call abort if (any (lcobound(c%a%i) /= (/ lc /))) call abort - if (ucobound(c%a%i, dim=1) /= this_image() + lc - 1) call abort + if (ucobound(c%a%i, dim=1) /= num_images() + lc - 1) call abort if (c%a(2)%i /= init(2)) call abort if (any (lcobound(c%a(2)) /= (/ lc /))) call abort - if (ucobound(c%a(2), dim=1) /= this_image() + lc - 1) call abort + if (ucobound(c%a(2), dim=1) /= num_images() + lc - 1) call abort if (any (lcobound(c%a(2)%i) /= (/ lc /))) call abort - if (ucobound(c%a(2)%i, dim=1) /= this_image() + lc - 1) call abort + if (ucobound(c%a(2)%i, dim=1) /= num_images() + lc - 1) call abort deallocate(b%a, c%a) end diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 new file mode 100644 index 00000000000..c0d06a4bd2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Allocate/deallocate with libcaf. +! + + integer(4), allocatable :: xx[:], yy(:)[:] + integer :: stat + character(len=200) :: errmsg + allocate(xx[*], stat=stat, errmsg=errmsg) + allocate(yy(2)[*], stat=stat, errmsg=errmsg) + deallocate(xx,yy,stat=stat, errmsg=errmsg) + end + +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .4, 1, &xx.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .8, 1, &yy.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 new file mode 100644 index 00000000000..3aaff1e8c35 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Allocate/deallocate with libcaf. +! + + type t + end type t + class(t), allocatable :: xx[:], yy(:)[:] + integer :: stat + character(len=200) :: errmsg + allocate(xx[*], stat=stat, errmsg=errmsg) + allocate(yy(2)[*], stat=stat, errmsg=errmsg) + deallocate(xx,yy,stat=stat, errmsg=errmsg) + end + +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat.f90 index b691f21c74e..b2ba95c740a 100644 --- a/gcc/testsuite/gfortran.dg/deallocate_stat.f90 +++ b/gcc/testsuite/gfortran.dg/deallocate_stat.f90 @@ -69,9 +69,9 @@ program deallocate_stat i = 13 deallocate(a1, stat=i) ; if (i /= 0) call abort deallocate(a2, a1, stat=i) ; if (i /= 1) call abort - deallocate(a1, a3, a2, stat=i) ; if (i /= 2) call abort + deallocate(a1, a3, a2, stat=i) ; if (i /= 1) call abort deallocate(b4, stat=i) ; if (i /= 0) call abort deallocate(b4, b5, stat=i) ; if (i /= 1) call abort - deallocate(b4, b5, b6, stat=i) ; if (i /= 2) call abort + deallocate(b4, b5, b6, stat=i) ; if (i /= 1) call abort end program deallocate_stat diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90 new file mode 100644 index 00000000000..e93f446a818 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! +! Check that the error is properly diagnosed and the strings are correctly padded. +! +integer, allocatable :: A, B(:) +integer :: stat +character(len=5) :: sstr +character(len=200) :: str + +str = repeat('X', len(str)) +deallocate(a, stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort() + +str = repeat('Y', len(str)) +deallocate(b, stat=stat, errmsg=str) +!print *, stat, trim(str) +if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort() + +sstr = repeat('Q', len(sstr)) +deallocate(a, stat=stat, errmsg=sstr) +!print *, stat, trim(sstr) +if (stat == 0 .or. sstr /= "Attem") call abort() + +sstr = repeat('P', len(sstr)) +deallocate(b, stat=stat, errmsg=sstr) +!print *, stat, trim(sstr) +if (stat == 0 .or. sstr /= "Attem") call abort() + +end diff --git a/gcc/testsuite/gfortran.dg/lto/pr41576_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr41576_0.f90 new file mode 100644 index 00000000000..feda0b174cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/pr41576_0.f90 @@ -0,0 +1,10 @@ +! { dg-lto-do run } +! { dg-lto-options { { -O2 -flto -Werror } } } + +subroutine foo + common /bar/ a, b + integer(4) :: a ,b + a = 1 + b = 2 +end + diff --git a/gcc/testsuite/gfortran.dg/lto/pr41576_1.f90 b/gcc/testsuite/gfortran.dg/lto/pr41576_1.f90 new file mode 100644 index 00000000000..6aefcc875e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/pr41576_1.f90 @@ -0,0 +1,7 @@ +program test + common /bar/ c, d + integer(4) :: c, d + call foo + if (c/=1 .or. d/=2) call abort +end program test + diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_8.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_8.f03 index b27210bc646..a3726ba9f1a 100644 --- a/gcc/testsuite/gfortran.dg/typebound_operator_8.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_operator_8.f03 @@ -1,500 +1,100 @@ ! { dg-do run } -! { dg-add-options ieee } +! PR48946 - complex expressions involving typebound operators of derived types. ! -! Solve a diffusion problem using an object-oriented approach -! -! Author: Arjen Markus (comp.lang.fortran) -! This version: pault@gcc.gnu.org -! -! Note: -! (i) This could be turned into a more sophisticated program -! using the techniques described in the chapter on -! mathematical abstractions. -! (That would allow the selection of the time integration -! method in a transparent way) -! -! (ii) The target procedures for process_p and source_p are -! different to the typebound procedures for dynamic types -! because the passed argument is not type(base_pde_object). -! -! (iii) Two solutions are calculated, one with the procedure -! pointers and the other with typebound procedures. The sums -! of the solutions are compared. - -! (iv) The source is a delta function in the middle of the -! mesh, whilst the process is quartic in the local value, -! when it is positive. -! -! base_pde_objects -- -! Module to define the basic objects -! -module base_pde_objects +module field_module implicit none - type, abstract :: base_pde_object -! No data - procedure(process_p), pointer, pass :: process_p - procedure(source_p), pointer, pass :: source_p + type ,abstract :: field contains - procedure(process), deferred :: process - procedure(source), deferred :: source - procedure :: initialise - procedure :: nabla2 - procedure :: print - procedure(real_times_obj), pass(obj), deferred :: real_times_obj - procedure(obj_plus_obj), deferred :: obj_plus_obj - procedure(obj_assign_obj), deferred :: obj_assign_obj - generic :: operator(*) => real_times_obj - generic :: operator(+) => obj_plus_obj - generic :: assignment(=) => obj_assign_obj + procedure(field_op_real) ,deferred :: multiply_real + procedure(field_plus_field) ,deferred :: plus + procedure(assign_field) ,deferred :: assn + generic :: operator(*) => multiply_real + generic :: operator(+) => plus + generic :: ASSIGNMENT(=) => assn end type abstract interface - function process_p (obj) - import base_pde_object - class(base_pde_object), intent(in) :: obj - class(base_pde_object), allocatable :: process_p - end function process_p - end interface - abstract interface - function source_p (obj, time) - import base_pde_object - class(base_pde_object), intent(in) :: obj - real, intent(in) :: time - class(base_pde_object), allocatable :: source_p - end function source_p + function field_plus_field(lhs,rhs) + import :: field + class(field) ,intent(in) :: lhs + class(field) ,intent(in) :: rhs + class(field) ,allocatable :: field_plus_field + end function end interface abstract interface - function process (obj) - import base_pde_object - class(base_pde_object), intent(in) :: obj - class(base_pde_object), allocatable :: process - end function process + function field_op_real(lhs,rhs) + import :: field + class(field) ,intent(in) :: lhs + real ,intent(in) :: rhs + class(field) ,allocatable :: field_op_real + end function end interface abstract interface - function source (obj, time) - import base_pde_object - class(base_pde_object), intent(in) :: obj - real, intent(in) :: time - class(base_pde_object), allocatable :: source - end function source + subroutine assign_field(lhs,rhs) + import :: field + class(field) ,intent(OUT) :: lhs + class(field) ,intent(IN) :: rhs + end subroutine end interface - abstract interface - function real_times_obj (factor, obj) result(newobj) - import base_pde_object - real, intent(in) :: factor - class(base_pde_object), intent(in) :: obj - class(base_pde_object), allocatable :: newobj - end function real_times_obj - end interface - abstract interface - function obj_plus_obj (obj1, obj2) result(newobj) - import base_pde_object - class(base_pde_object), intent(in) :: obj1 - class(base_pde_object), intent(in) :: obj2 - class(base_pde_object), allocatable :: newobj - end function obj_plus_obj - end interface - abstract interface - subroutine obj_assign_obj (obj1, obj2) - import base_pde_object - class(base_pde_object), intent(inout) :: obj1 - class(base_pde_object), intent(in) :: obj2 - end subroutine obj_assign_obj - end interface -contains -! print -- -! Print the concentration field - subroutine print (obj) - class(base_pde_object) :: obj - ! Dummy - end subroutine print -! initialise -- -! Initialise the concentration field using a specific function - subroutine initialise (obj, funcxy) - class(base_pde_object) :: obj - interface - real function funcxy (coords) - real, dimension(:), intent(in) :: coords - end function funcxy - end interface - ! Dummy - end subroutine initialise -! nabla2 -- -! Determine the divergence - function nabla2 (obj) - class(base_pde_object), intent(in) :: obj - class(base_pde_object), allocatable :: nabla2 - ! Dummy - end function nabla2 -end module base_pde_objects -! cartesian_2d_objects -- -! PDE object on a 2D cartesian grid -! -module cartesian_2d_objects - use base_pde_objects +end module + +module i_field_module + use field_module implicit none - type, extends(base_pde_object) :: cartesian_2d_object - real, dimension(:,:), allocatable :: c - real :: dx - real :: dy + type, extends (field) :: i_field + integer :: i contains - procedure :: process => process_cart2d - procedure :: source => source_cart2d - procedure :: initialise => initialise_cart2d - procedure :: nabla2 => nabla2_cart2d - procedure :: print => print_cart2d - procedure, pass(obj) :: real_times_obj => real_times_cart2d - procedure :: obj_plus_obj => obj_plus_cart2d - procedure :: obj_assign_obj => obj_assign_cart2d - end type cartesian_2d_object - interface grid_definition - module procedure grid_definition_cart2d - end interface + procedure :: multiply_real => i_multiply_real + procedure :: plus => i_plus_i + procedure :: assn => i_assn + end type contains - function process_cart2d (obj) - class(cartesian_2d_object), intent(in) :: obj - class(base_pde_object), allocatable :: process_cart2d - allocate (process_cart2d,source = obj) - select type (process_cart2d) - type is (cartesian_2d_object) - process_cart2d%c = -sign (obj%c, 1.0)*obj%c** 4 - class default - call abort - end select - end function process_cart2d - function process_cart2d_p (obj) - class(base_pde_object), intent(in) :: obj - class(base_pde_object), allocatable :: process_cart2d_p - allocate (process_cart2d_p,source = obj) - select type (process_cart2d_p) - type is (cartesian_2d_object) - select type (obj) - type is (cartesian_2d_object) - process_cart2d_p%c = -sign (obj%c, 1.0)*obj%c** 4 - end select - class default - call abort + function i_plus_i(lhs,rhs) + class(i_field) ,intent(in) :: lhs + class(field) ,intent(in) :: rhs + class(field) ,allocatable :: i_plus_i + integer :: m = 0 + select type (lhs) + type is (i_field); m = lhs%i end select - end function process_cart2d_p - function source_cart2d (obj, time) - class(cartesian_2d_object), intent(in) :: obj - real, intent(in) :: time - class(base_pde_object), allocatable :: source_cart2d - integer :: m, n - m = size (obj%c, 1) - n = size (obj%c, 2) - allocate (source_cart2d, source = obj) - select type (source_cart2d) - type is (cartesian_2d_object) - if (allocated (source_cart2d%c)) deallocate (source_cart2d%c) - allocate (source_cart2d%c(m, n)) - source_cart2d%c = 0.0 - if (time .lt. 5.0) source_cart2d%c(m/2, n/2) = 0.1 - class default - call abort + select type (rhs) + type is (i_field); m = rhs%i + m end select - end function source_cart2d - - function source_cart2d_p (obj, time) - class(base_pde_object), intent(in) :: obj - real, intent(in) :: time - class(base_pde_object), allocatable :: source_cart2d_p - integer :: m, n - select type (obj) - type is (cartesian_2d_object) - m = size (obj%c, 1) - n = size (obj%c, 2) - class default - call abort - end select - allocate (source_cart2d_p,source = obj) - select type (source_cart2d_p) - type is (cartesian_2d_object) - if (allocated (source_cart2d_p%c)) deallocate (source_cart2d_p%c) - allocate (source_cart2d_p%c(m,n)) - source_cart2d_p%c = 0.0 - if (time .lt. 5.0) source_cart2d_p%c(m/2, n/2) = 0.1 - class default - call abort + allocate (i_plus_i, source = i_field (m)) + end function + function i_multiply_real(lhs,rhs) + class(i_field) ,intent(in) :: lhs + real ,intent(in) :: rhs + class(field) ,allocatable :: i_multiply_real + integer :: m = 0 + select type (lhs) + type is (i_field); m = lhs%i * int (rhs) end select - end function source_cart2d_p + allocate (i_multiply_real, source = i_field (m)) + end function + subroutine i_assn(lhs,rhs) + class(i_field) ,intent(OUT) :: lhs + class(field) ,intent(IN) :: rhs + select type (lhs) + type is (i_field) + select type (rhs) + type is (i_field) + lhs%i = rhs%i + end select + end select + end subroutine +end module -! grid_definition -- -! Initialises the grid -! - subroutine grid_definition_cart2d (obj, sizes, dims) - class(base_pde_object), allocatable :: obj - real, dimension(:) :: sizes - integer, dimension(:) :: dims - allocate( cartesian_2d_object :: obj ) - select type (obj) - type is (cartesian_2d_object) - allocate (obj%c(dims(1), dims(2))) - obj%c = 0.0 - obj%dx = sizes(1)/dims(1) - obj%dy = sizes(2)/dims(2) - class default - call abort - end select - end subroutine grid_definition_cart2d -! print_cart2d -- -! Print the concentration field to the screen -! - subroutine print_cart2d (obj) - class(cartesian_2d_object) :: obj - character(len=20) :: format - write( format, '(a,i0,a)' ) '(', size(obj%c,1), 'f6.3)' - write( *, format ) obj%c - end subroutine print_cart2d -! initialise_cart2d -- -! Initialise the concentration field using a specific function -! - subroutine initialise_cart2d (obj, funcxy) - class(cartesian_2d_object) :: obj - interface - real function funcxy (coords) - real, dimension(:), intent(in) :: coords - end function funcxy - end interface - integer :: i, j - real, dimension(2) :: x - obj%c = 0.0 - do j = 2,size (obj%c, 2)-1 - x(2) = obj%dy * (j-1) - do i = 2,size (obj%c, 1)-1 - x(1) = obj%dx * (i-1) - obj%c(i,j) = funcxy (x) - enddo - enddo - end subroutine initialise_cart2d -! nabla2_cart2d -! Determine the divergence - function nabla2_cart2d (obj) - class(cartesian_2d_object), intent(in) :: obj - class(base_pde_object), allocatable :: nabla2_cart2d - integer :: m, n - real :: dx, dy - m = size (obj%c, 1) - n = size (obj%c, 2) - dx = obj%dx - dy = obj%dy - allocate (cartesian_2d_object :: nabla2_cart2d) - select type (nabla2_cart2d) - type is (cartesian_2d_object) - allocate (nabla2_cart2d%c(m,n)) - nabla2_cart2d%c = 0.0 - nabla2_cart2d%c(2:m-1,2:n-1) = & - -(2.0 * obj%c(2:m-1,2:n-1) - obj%c(1:m-2,2:n-1) - obj%c(3:m,2:n-1)) / dx**2 & - -(2.0 * obj%c(2:m-1,2:n-1) - obj%c(2:m-1,1:n-2) - obj%c(2:m-1,3:n)) / dy**2 - class default - call abort - end select - end function nabla2_cart2d - function real_times_cart2d (factor, obj) result(newobj) - real, intent(in) :: factor - class(cartesian_2d_object), intent(in) :: obj - class(base_pde_object), allocatable :: newobj - integer :: m, n - m = size (obj%c, 1) - n = size (obj%c, 2) - allocate (cartesian_2d_object :: newobj) - select type (newobj) - type is (cartesian_2d_object) - allocate (newobj%c(m,n)) - newobj%c = factor * obj%c - class default - call abort - end select - end function real_times_cart2d - function obj_plus_cart2d (obj1, obj2) result( newobj ) - class(cartesian_2d_object), intent(in) :: obj1 - class(base_pde_object), intent(in) :: obj2 - class(base_pde_object), allocatable :: newobj - integer :: m, n - m = size (obj1%c, 1) - n = size (obj1%c, 2) - allocate (cartesian_2d_object :: newobj) - select type (newobj) - type is (cartesian_2d_object) - allocate (newobj%c(m,n)) - select type (obj2) - type is (cartesian_2d_object) - newobj%c = obj1%c + obj2%c - class default - call abort - end select - class default - call abort - end select - end function obj_plus_cart2d - subroutine obj_assign_cart2d (obj1, obj2) - class(cartesian_2d_object), intent(inout) :: obj1 - class(base_pde_object), intent(in) :: obj2 - select type (obj2) - type is (cartesian_2d_object) - obj1%c = obj2%c - class default - call abort - end select - end subroutine obj_assign_cart2d -end module cartesian_2d_objects -! define_pde_objects -- -! Module to bring all the PDE object types together -! -module define_pde_objects - use base_pde_objects - use cartesian_2d_objects - implicit none - interface grid_definition - module procedure grid_definition_general - end interface -contains - subroutine grid_definition_general (obj, type, sizes, dims) - class(base_pde_object), allocatable :: obj - character(len=*) :: type - real, dimension(:) :: sizes - integer, dimension(:) :: dims - select case (type) - case ("cartesian 2d") - call grid_definition (obj, sizes, dims) - case default - write(*,*) 'Unknown grid type: ', trim (type) - stop - end select - end subroutine grid_definition_general -end module define_pde_objects -! pde_specific -- -! Module holding the routines specific to the PDE that -! we are solving -! -module pde_specific +program main + use i_field_module implicit none -contains - real function patch (coords) - real, dimension(:), intent(in) :: coords - if (sum ((coords-[50.0,50.0])**2) < 40.0) then - patch = 1.0 - else - patch = 0.0 - endif - end function patch -end module pde_specific -! test_pde_solver -- -! Small test program to demonstrate the usage -! -program test_pde_solver - use define_pde_objects - use pde_specific - implicit none - class(base_pde_object), allocatable :: solution, deriv - integer :: i - real :: time, dtime, diff, chksum(2) + type(i_field) ,allocatable :: u + allocate (u, source = i_field (99)) - call simulation1 ! Use proc pointers for source and process define_pde_objects - select type (solution) - type is (cartesian_2d_object) - deallocate (solution%c) - end select - select type (deriv) - type is (cartesian_2d_object) - deallocate (deriv%c) - end select - deallocate (solution, deriv) - - call simulation2 ! Use typebound procedures for source and process - if (chksum(1) .ne. chksum(2)) call abort - if ((chksum(1) - 0.881868720)**2 > 1e-4) call abort -contains - subroutine simulation1 -! -! Create the grid -! - call grid_definition (solution, "cartesian 2d", [100.0, 100.0], [16, 16]) - call grid_definition (deriv, "cartesian 2d", [100.0, 100.0], [16, 16]) -! -! Initialise the concentration field -! - call solution%initialise (patch) -! -! Set the procedure pointers -! - solution%source_p => source_cart2d_p - solution%process_p => process_cart2d_p -! -! Perform the integration - explicit method -! - time = 0.0 - dtime = 0.1 - diff = 5.0e-3 - -! Give the diffusion coefficient correct dimensions. - select type (solution) - type is (cartesian_2d_object) - diff = diff * solution%dx * solution%dy / dtime - end select - -! write(*,*) 'Time: ', time, diff -! call solution%print - do i = 1,100 - deriv = solution%nabla2 () - solution = solution + diff * dtime * deriv + solution%source_p (time) + solution%process_p () -! if ( mod(i, 25) == 0 ) then -! write(*,*)'Time: ', time -! call solution%print -! endif - time = time + dtime - enddo -! write(*,*) 'End result 1: ' -! call solution%print - select type (solution) - type is (cartesian_2d_object) - chksum(1) = sum (solution%c) - end select - end subroutine - subroutine simulation2 -! -! Create the grid -! - call grid_definition (solution, "cartesian 2d", [100.0, 100.0], [16, 16]) - call grid_definition (deriv, "cartesian 2d", [100.0, 100.0], [16, 16]) -! -! Initialise the concentration field -! - call solution%initialise (patch) -! -! Set the procedure pointers -! - solution%source_p => source_cart2d_p - solution%process_p => process_cart2d_p -! -! Perform the integration - explicit method -! - time = 0.0 - dtime = 0.1 - diff = 5.0e-3 - -! Give the diffusion coefficient correct dimensions. - select type (solution) - type is (cartesian_2d_object) - diff = diff * solution%dx * solution%dy / dtime - end select - -! write(*,*) 'Time: ', time, diff -! call solution%print - do i = 1,100 - deriv = solution%nabla2 () - solution = solution + diff * dtime * deriv + solution%source (time) + solution%process () -! if ( mod(i, 25) == 0 ) then -! write(*,*)'Time: ', time -! call solution%print -! endif - time = time + dtime - enddo -! write(*,*) 'End result 2: ' -! call solution%print - select type (solution) - type is (cartesian_2d_object) - chksum(2) = sum (solution%c) - end select - end subroutine -end program test_pde_solver -! { dg-final { cleanup-modules "pde_specific define_pde_objects cartesian_2d_objects base_pde_objects" } } + u = u*2. + u = (u*2.0*4.0) + u*4.0 + u = u%multiply_real (2.0)*4.0 + u = i_multiply_real (u, 2.0) * 4.0 + + if (u%i .ne. 152064) call abort +end program +! { dg-final { cleanup-modules "field_module i_field_module" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_9.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_9.f03 new file mode 100644 index 00000000000..b27210bc646 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_operator_9.f03 @@ -0,0 +1,500 @@ +! { dg-do run } +! { dg-add-options ieee } +! +! Solve a diffusion problem using an object-oriented approach +! +! Author: Arjen Markus (comp.lang.fortran) +! This version: pault@gcc.gnu.org +! +! Note: +! (i) This could be turned into a more sophisticated program +! using the techniques described in the chapter on +! mathematical abstractions. +! (That would allow the selection of the time integration +! method in a transparent way) +! +! (ii) The target procedures for process_p and source_p are +! different to the typebound procedures for dynamic types +! because the passed argument is not type(base_pde_object). +! +! (iii) Two solutions are calculated, one with the procedure +! pointers and the other with typebound procedures. The sums +! of the solutions are compared. + +! (iv) The source is a delta function in the middle of the +! mesh, whilst the process is quartic in the local value, +! when it is positive. +! +! base_pde_objects -- +! Module to define the basic objects +! +module base_pde_objects + implicit none + type, abstract :: base_pde_object +! No data + procedure(process_p), pointer, pass :: process_p + procedure(source_p), pointer, pass :: source_p + contains + procedure(process), deferred :: process + procedure(source), deferred :: source + procedure :: initialise + procedure :: nabla2 + procedure :: print + procedure(real_times_obj), pass(obj), deferred :: real_times_obj + procedure(obj_plus_obj), deferred :: obj_plus_obj + procedure(obj_assign_obj), deferred :: obj_assign_obj + generic :: operator(*) => real_times_obj + generic :: operator(+) => obj_plus_obj + generic :: assignment(=) => obj_assign_obj + end type + abstract interface + function process_p (obj) + import base_pde_object + class(base_pde_object), intent(in) :: obj + class(base_pde_object), allocatable :: process_p + end function process_p + end interface + abstract interface + function source_p (obj, time) + import base_pde_object + class(base_pde_object), intent(in) :: obj + real, intent(in) :: time + class(base_pde_object), allocatable :: source_p + end function source_p + end interface + abstract interface + function process (obj) + import base_pde_object + class(base_pde_object), intent(in) :: obj + class(base_pde_object), allocatable :: process + end function process + end interface + abstract interface + function source (obj, time) + import base_pde_object + class(base_pde_object), intent(in) :: obj + real, intent(in) :: time + class(base_pde_object), allocatable :: source + end function source + end interface + abstract interface + function real_times_obj (factor, obj) result(newobj) + import base_pde_object + real, intent(in) :: factor + class(base_pde_object), intent(in) :: obj + class(base_pde_object), allocatable :: newobj + end function real_times_obj + end interface + abstract interface + function obj_plus_obj (obj1, obj2) result(newobj) + import base_pde_object + class(base_pde_object), intent(in) :: obj1 + class(base_pde_object), intent(in) :: obj2 + class(base_pde_object), allocatable :: newobj + end function obj_plus_obj + end interface + abstract interface + subroutine obj_assign_obj (obj1, obj2) + import base_pde_object + class(base_pde_object), intent(inout) :: obj1 + class(base_pde_object), intent(in) :: obj2 + end subroutine obj_assign_obj + end interface +contains +! print -- +! Print the concentration field + subroutine print (obj) + class(base_pde_object) :: obj + ! Dummy + end subroutine print +! initialise -- +! Initialise the concentration field using a specific function + subroutine initialise (obj, funcxy) + class(base_pde_object) :: obj + interface + real function funcxy (coords) + real, dimension(:), intent(in) :: coords + end function funcxy + end interface + ! Dummy + end subroutine initialise +! nabla2 -- +! Determine the divergence + function nabla2 (obj) + class(base_pde_object), intent(in) :: obj + class(base_pde_object), allocatable :: nabla2 + ! Dummy + end function nabla2 +end module base_pde_objects +! cartesian_2d_objects -- +! PDE object on a 2D cartesian grid +! +module cartesian_2d_objects + use base_pde_objects + implicit none + type, extends(base_pde_object) :: cartesian_2d_object + real, dimension(:,:), allocatable :: c + real :: dx + real :: dy + contains + procedure :: process => process_cart2d + procedure :: source => source_cart2d + procedure :: initialise => initialise_cart2d + procedure :: nabla2 => nabla2_cart2d + procedure :: print => print_cart2d + procedure, pass(obj) :: real_times_obj => real_times_cart2d + procedure :: obj_plus_obj => obj_plus_cart2d + procedure :: obj_assign_obj => obj_assign_cart2d + end type cartesian_2d_object + interface grid_definition + module procedure grid_definition_cart2d + end interface +contains + function process_cart2d (obj) + class(cartesian_2d_object), intent(in) :: obj + class(base_pde_object), allocatable :: process_cart2d + allocate (process_cart2d,source = obj) + select type (process_cart2d) + type is (cartesian_2d_object) + process_cart2d%c = -sign (obj%c, 1.0)*obj%c** 4 + class default + call abort + end select + end function process_cart2d + function process_cart2d_p (obj) + class(base_pde_object), intent(in) :: obj + class(base_pde_object), allocatable :: process_cart2d_p + allocate (process_cart2d_p,source = obj) + select type (process_cart2d_p) + type is (cartesian_2d_object) + select type (obj) + type is (cartesian_2d_object) + process_cart2d_p%c = -sign (obj%c, 1.0)*obj%c** 4 + end select + class default + call abort + end select + end function process_cart2d_p + function source_cart2d (obj, time) + class(cartesian_2d_object), intent(in) :: obj + real, intent(in) :: time + class(base_pde_object), allocatable :: source_cart2d + integer :: m, n + m = size (obj%c, 1) + n = size (obj%c, 2) + allocate (source_cart2d, source = obj) + select type (source_cart2d) + type is (cartesian_2d_object) + if (allocated (source_cart2d%c)) deallocate (source_cart2d%c) + allocate (source_cart2d%c(m, n)) + source_cart2d%c = 0.0 + if (time .lt. 5.0) source_cart2d%c(m/2, n/2) = 0.1 + class default + call abort + end select + end function source_cart2d + + function source_cart2d_p (obj, time) + class(base_pde_object), intent(in) :: obj + real, intent(in) :: time + class(base_pde_object), allocatable :: source_cart2d_p + integer :: m, n + select type (obj) + type is (cartesian_2d_object) + m = size (obj%c, 1) + n = size (obj%c, 2) + class default + call abort + end select + allocate (source_cart2d_p,source = obj) + select type (source_cart2d_p) + type is (cartesian_2d_object) + if (allocated (source_cart2d_p%c)) deallocate (source_cart2d_p%c) + allocate (source_cart2d_p%c(m,n)) + source_cart2d_p%c = 0.0 + if (time .lt. 5.0) source_cart2d_p%c(m/2, n/2) = 0.1 + class default + call abort + end select + end function source_cart2d_p + +! grid_definition -- +! Initialises the grid +! + subroutine grid_definition_cart2d (obj, sizes, dims) + class(base_pde_object), allocatable :: obj + real, dimension(:) :: sizes + integer, dimension(:) :: dims + allocate( cartesian_2d_object :: obj ) + select type (obj) + type is (cartesian_2d_object) + allocate (obj%c(dims(1), dims(2))) + obj%c = 0.0 + obj%dx = sizes(1)/dims(1) + obj%dy = sizes(2)/dims(2) + class default + call abort + end select + end subroutine grid_definition_cart2d +! print_cart2d -- +! Print the concentration field to the screen +! + subroutine print_cart2d (obj) + class(cartesian_2d_object) :: obj + character(len=20) :: format + write( format, '(a,i0,a)' ) '(', size(obj%c,1), 'f6.3)' + write( *, format ) obj%c + end subroutine print_cart2d +! initialise_cart2d -- +! Initialise the concentration field using a specific function +! + subroutine initialise_cart2d (obj, funcxy) + class(cartesian_2d_object) :: obj + interface + real function funcxy (coords) + real, dimension(:), intent(in) :: coords + end function funcxy + end interface + integer :: i, j + real, dimension(2) :: x + obj%c = 0.0 + do j = 2,size (obj%c, 2)-1 + x(2) = obj%dy * (j-1) + do i = 2,size (obj%c, 1)-1 + x(1) = obj%dx * (i-1) + obj%c(i,j) = funcxy (x) + enddo + enddo + end subroutine initialise_cart2d +! nabla2_cart2d +! Determine the divergence + function nabla2_cart2d (obj) + class(cartesian_2d_object), intent(in) :: obj + class(base_pde_object), allocatable :: nabla2_cart2d + integer :: m, n + real :: dx, dy + m = size (obj%c, 1) + n = size (obj%c, 2) + dx = obj%dx + dy = obj%dy + allocate (cartesian_2d_object :: nabla2_cart2d) + select type (nabla2_cart2d) + type is (cartesian_2d_object) + allocate (nabla2_cart2d%c(m,n)) + nabla2_cart2d%c = 0.0 + nabla2_cart2d%c(2:m-1,2:n-1) = & + -(2.0 * obj%c(2:m-1,2:n-1) - obj%c(1:m-2,2:n-1) - obj%c(3:m,2:n-1)) / dx**2 & + -(2.0 * obj%c(2:m-1,2:n-1) - obj%c(2:m-1,1:n-2) - obj%c(2:m-1,3:n)) / dy**2 + class default + call abort + end select + end function nabla2_cart2d + function real_times_cart2d (factor, obj) result(newobj) + real, intent(in) :: factor + class(cartesian_2d_object), intent(in) :: obj + class(base_pde_object), allocatable :: newobj + integer :: m, n + m = size (obj%c, 1) + n = size (obj%c, 2) + allocate (cartesian_2d_object :: newobj) + select type (newobj) + type is (cartesian_2d_object) + allocate (newobj%c(m,n)) + newobj%c = factor * obj%c + class default + call abort + end select + end function real_times_cart2d + function obj_plus_cart2d (obj1, obj2) result( newobj ) + class(cartesian_2d_object), intent(in) :: obj1 + class(base_pde_object), intent(in) :: obj2 + class(base_pde_object), allocatable :: newobj + integer :: m, n + m = size (obj1%c, 1) + n = size (obj1%c, 2) + allocate (cartesian_2d_object :: newobj) + select type (newobj) + type is (cartesian_2d_object) + allocate (newobj%c(m,n)) + select type (obj2) + type is (cartesian_2d_object) + newobj%c = obj1%c + obj2%c + class default + call abort + end select + class default + call abort + end select + end function obj_plus_cart2d + subroutine obj_assign_cart2d (obj1, obj2) + class(cartesian_2d_object), intent(inout) :: obj1 + class(base_pde_object), intent(in) :: obj2 + select type (obj2) + type is (cartesian_2d_object) + obj1%c = obj2%c + class default + call abort + end select + end subroutine obj_assign_cart2d +end module cartesian_2d_objects +! define_pde_objects -- +! Module to bring all the PDE object types together +! +module define_pde_objects + use base_pde_objects + use cartesian_2d_objects + implicit none + interface grid_definition + module procedure grid_definition_general + end interface +contains + subroutine grid_definition_general (obj, type, sizes, dims) + class(base_pde_object), allocatable :: obj + character(len=*) :: type + real, dimension(:) :: sizes + integer, dimension(:) :: dims + select case (type) + case ("cartesian 2d") + call grid_definition (obj, sizes, dims) + case default + write(*,*) 'Unknown grid type: ', trim (type) + stop + end select + end subroutine grid_definition_general +end module define_pde_objects +! pde_specific -- +! Module holding the routines specific to the PDE that +! we are solving +! +module pde_specific + implicit none +contains + real function patch (coords) + real, dimension(:), intent(in) :: coords + if (sum ((coords-[50.0,50.0])**2) < 40.0) then + patch = 1.0 + else + patch = 0.0 + endif + end function patch +end module pde_specific +! test_pde_solver -- +! Small test program to demonstrate the usage +! +program test_pde_solver + use define_pde_objects + use pde_specific + implicit none + class(base_pde_object), allocatable :: solution, deriv + integer :: i + real :: time, dtime, diff, chksum(2) + + call simulation1 ! Use proc pointers for source and process define_pde_objects + select type (solution) + type is (cartesian_2d_object) + deallocate (solution%c) + end select + select type (deriv) + type is (cartesian_2d_object) + deallocate (deriv%c) + end select + deallocate (solution, deriv) + + call simulation2 ! Use typebound procedures for source and process + if (chksum(1) .ne. chksum(2)) call abort + if ((chksum(1) - 0.881868720)**2 > 1e-4) call abort +contains + subroutine simulation1 +! +! Create the grid +! + call grid_definition (solution, "cartesian 2d", [100.0, 100.0], [16, 16]) + call grid_definition (deriv, "cartesian 2d", [100.0, 100.0], [16, 16]) +! +! Initialise the concentration field +! + call solution%initialise (patch) +! +! Set the procedure pointers +! + solution%source_p => source_cart2d_p + solution%process_p => process_cart2d_p +! +! Perform the integration - explicit method +! + time = 0.0 + dtime = 0.1 + diff = 5.0e-3 + +! Give the diffusion coefficient correct dimensions. + select type (solution) + type is (cartesian_2d_object) + diff = diff * solution%dx * solution%dy / dtime + end select + +! write(*,*) 'Time: ', time, diff +! call solution%print + do i = 1,100 + deriv = solution%nabla2 () + solution = solution + diff * dtime * deriv + solution%source_p (time) + solution%process_p () +! if ( mod(i, 25) == 0 ) then +! write(*,*)'Time: ', time +! call solution%print +! endif + time = time + dtime + enddo +! write(*,*) 'End result 1: ' +! call solution%print + select type (solution) + type is (cartesian_2d_object) + chksum(1) = sum (solution%c) + end select + end subroutine + subroutine simulation2 +! +! Create the grid +! + call grid_definition (solution, "cartesian 2d", [100.0, 100.0], [16, 16]) + call grid_definition (deriv, "cartesian 2d", [100.0, 100.0], [16, 16]) +! +! Initialise the concentration field +! + call solution%initialise (patch) +! +! Set the procedure pointers +! + solution%source_p => source_cart2d_p + solution%process_p => process_cart2d_p +! +! Perform the integration - explicit method +! + time = 0.0 + dtime = 0.1 + diff = 5.0e-3 + +! Give the diffusion coefficient correct dimensions. + select type (solution) + type is (cartesian_2d_object) + diff = diff * solution%dx * solution%dy / dtime + end select + +! write(*,*) 'Time: ', time, diff +! call solution%print + do i = 1,100 + deriv = solution%nabla2 () + solution = solution + diff * dtime * deriv + solution%source (time) + solution%process () +! if ( mod(i, 25) == 0 ) then +! write(*,*)'Time: ', time +! call solution%print +! endif + time = time + dtime + enddo +! write(*,*) 'End result 2: ' +! call solution%print + select type (solution) + type is (cartesian_2d_object) + chksum(2) = sum (solution%c) + end select + end subroutine +end program test_pde_solver +! { dg-final { cleanup-modules "pde_specific define_pde_objects cartesian_2d_objects base_pde_objects" } } diff --git a/gcc/testsuite/go.test/test/cmp6.go b/gcc/testsuite/go.test/test/cmp6.go index b3ea8ffebfd..0113a69ddb8 100644 --- a/gcc/testsuite/go.test/test/cmp6.go +++ b/gcc/testsuite/go.test/test/cmp6.go @@ -11,7 +11,7 @@ func use(bool) {} type T1 *int type T2 *int -type T3 struct {} +type T3 struct{ z []int } var t3 T3 @@ -21,12 +21,12 @@ func main() { // so chan int can be compared against // directional channels but channel of different // direction cannot be compared against each other. - var c1 chan <-int + var c1 chan<- int var c2 <-chan int var c3 chan int - - use(c1 == c2) // ERROR "invalid operation|incompatible" - use(c2 == c1) // ERROR "invalid operation|incompatible" + + use(c1 == c2) // ERROR "invalid operation|incompatible" + use(c2 == c1) // ERROR "invalid operation|incompatible" use(c1 == c3) use(c2 == c2) use(c3 == c1) @@ -36,14 +36,32 @@ func main() { var p1 T1 var p2 T2 var p3 *int - - use(p1 == p2) // ERROR "invalid operation|incompatible" - use(p2 == p1) // ERROR "invalid operation|incompatible" + + use(p1 == p2) // ERROR "invalid operation|incompatible" + use(p2 == p1) // ERROR "invalid operation|incompatible" use(p1 == p3) use(p2 == p2) use(p3 == p1) use(p3 == p2) - + // Comparison of structs should have a good message - use(t3 == t3) // ERROR "struct|expected" + use(t3 == t3) // ERROR "struct|expected" + + // Slices, functions, and maps too. + var x []int + var f func() + var m map[int]int + use(x == x) // ERROR "slice can only be compared to nil" + use(f == f) // ERROR "func can only be compared to nil" + use(m == m) // ERROR "map can only be compared to nil" + + // Comparison with interface that cannot return true + // (would panic). + var i interface{} + use(i == x) // ERROR "invalid operation" + use(x == i) // ERROR "invalid operation" + use(i == f) // ERROR "invalid operation" + use(f == i) // ERROR "invalid operation" + use(i == m) // ERROR "invalid operation" + use(m == i) // ERROR "invalid operation" } diff --git a/gcc/testsuite/go.test/test/recover2.go b/gcc/testsuite/go.test/test/recover2.go index ccaf8ced16b..b5db6f0d1ca 100644 --- a/gcc/testsuite/go.test/test/recover2.go +++ b/gcc/testsuite/go.test/test/recover2.go @@ -60,6 +60,7 @@ func test4() { type T struct { a, b int + c []int } func test5() { |