3 use Parallel::MPI::Simple;
5 # Test basic functionality and blocking
8 $rank = MPI_Comm_rank(MPI_COMM_WORLD);
9 $size = MPI_Comm_size(MPI_COMM_WORLD);
12 my $msg = "Hi ho the lillies grow\n";
13 MPI_Send($msg,1,0,MPI_COMM_WORLD);
14 $msg = MPI_Recv(1,0,MPI_COMM_WORLD);
17 print "ok 2 # MPI_Send MPI_Recv\n";
18 MPI_Barrier(MPI_COMM_WORLD);
21 my $msg = MPI_Recv(0,0,MPI_COMM_WORLD);
22 $msg =~ s/(Hi ho).*/ok 1/;
23 MPI_Send($msg, 0,0,MPI_COMM_WORLD);
25 MPI_Barrier(MPI_COMM_WORLD);
26 print "ok 3 # MPI_Barrier\n";
30 MPI_Barrier(MPI_COMM_WORLD);
33 $msg = MPI_Bcast($msg, 0,MPI_COMM_WORLD);
36 my $msg = MPI_Bcast(undef, 0, MPI_COMM_WORLD);
37 print "ok $msg # MPI_Bcast\n";
41 MPI_Barrier(MPI_COMM_WORLD);
43 my $msg = "ok 5 # MPI_Gather\n";
44 print MPI_Gather($msg, 0, MPI_COMM_WORLD);
47 my $msg = "ok 6 # MPI_Gather\n";
48 print MPI_Gather($msg, 0, MPI_COMM_WORLD); # shouldn't print anything.
52 MPI_Barrier(MPI_COMM_WORLD);
54 my $rt = MPI_Scatter(["ok 7 # MPI_Scatter\n", "ok 8\n"],
56 print $rt if $rank ==0;
57 MPI_Barrier(MPI_COMM_WORLD);
58 print $rt if $rank ==1;
62 MPI_Barrier(MPI_COMM_WORLD);
63 { print "ok 9 # Skipped - blessed references\n" if $rank ==0; last;
64 my $obj = bless {cows=>"ok 9 # blessed ref\n"}, 'ZZZZZ::Testing';
67 MPI_Send($obj, 1, 0, MPI_COMM_WORLD);
70 $sobj = MPI_Recv($obj, 0, 0, MPI_COMM_WORLD);
76 MPI_Barrier(MPI_COMM_WORLD);
78 my @rt = MPI_Allgather($rank, MPI_COMM_WORLD);
80 print "ok ". ($rt[0]+10) . " # MPI_Allgather\n";
81 print "ok ". ($rt[1]+10) . "\n";
82 MPI_Barrier(MPI_COMM_WORLD);
85 MPI_Barrier(MPI_COMM_WORLD);
86 print "ok ". ($rt[0]+12)."\n";
87 print "ok ". ($rt[1]+12)."\n";
93 MPI_Barrier(MPI_COMM_WORLD);
94 my @data = (14+2*$rank, 15+2*$rank);
95 my @return = MPI_Alltoall(\@data, MPI_COMM_WORLD);
97 print "ok $return[0] # MPI_Alltoall\n"; # 14
98 MPI_Barrier(MPI_COMM_WORLD);
99 print "ok $return[1]\n";
100 MPI_Barrier(MPI_COMM_WORLD);
103 MPI_Barrier(MPI_COMM_WORLD);
104 print "ok $return[0]\n";
105 MPI_Barrier(MPI_COMM_WORLD);
106 print "ok $return[1]\n";
111 MPI_Barrier(MPI_COMM_WORLD);
113 my $rt = MPI_Reduce($rank, sub {$_[0] + $_[1]}, MPI_COMM_WORLD);
115 print "not " unless $rt == 1;
116 print "ok 18 # reduce\n";
119 print "not " unless $rt == 1;
120 print "ok 19 # reduce\n";
124 MPI_Barrier(MPI_COMM_WORLD);
126 if (MPI_Comm_compare(MPI_COMM_WORLD,MPI_COMM_WORLD) != MPI_IDENT) {
129 print "ok 2$rank # Comm_compare (ident)\n";
133 MPI_Barrier(MPI_COMM_WORLD);
134 my $dup = MPI_Comm_dup(MPI_COMM_WORLD);
135 if ($rank==0&&MPI_Comm_compare($dup, MPI_COMM_WORLD) != MPI_CONGRUENT) {
138 print "ok 22 # comm_dup\n" if $rank ==0;
143 MPI_Barrier(MPI_COMM_WORLD);
145 my $newcomm = MPI_Comm_split(MPI_COMM_WORLD, $rank, 0);
146 if (MPI_Comm_compare($newcomm, MPI_COMM_WORLD) !=
150 print "ok 23 # MPI_Comm_split\n";
151 MPI_Comm_free($newcomm);
154 my $rt=MPI_Comm_split(MPI_COMM_WORLD, MPI_UNDEFINED, 0);
155 if (defined($rt)) {print "not "}
156 print "ok 24 # MPI_Comm_split, not in new\n";
160 MPI_Barrier(MPI_COMM_WORLD);
162 my $msg = "Sending from ANY";
163 MPI_Send($msg,1,0,MPI_COMM_WORLD);
164 print "ok 25 # sent from ANY\n";
167 my $msg = MPI_Recv(MPI_ANY_SOURCE,0,MPI_COMM_WORLD);
168 if ($msg =~ /Sending from ANY/) {
169 print "ok 26 # receive from ANY_SOURCE";
172 print "not ok 26 # receive from ANY_SOURCE";
179 package ZZZZZ::Testing;
181 return $_[0]->{cows};