| Marc Kupietz | 3e3e326 | 2022-04-12 23:11:45 +0200 | [diff] [blame] | 1 | use strict; |
| 2 | use warnings; |
| Marc Kupietz | 565274e | 2026-09-06 13:17:17 +0200 | [diff] [blame] | 3 | use Test::More tests=>13; |
| Marc Kupietz | 3e3e326 | 2022-04-12 23:11:45 +0200 | [diff] [blame] | 4 | use Mojo::JSON qw(decode_json encode_json to_json); |
| 5 | use REST::Client; |
| 6 | use Data::Dump qw(dump); |
| 7 | |
| 8 | my $pid = fork(); |
| 9 | my $res; |
| 10 | unless ($pid) { |
| 11 | unless (fork) { |
| 12 | exec "MOJO_CONFIG=../example.conf morbo script/derekovecs-server"; |
| 13 | die "exec failed!"; |
| 14 | } |
| 15 | exit(0); |
| 16 | } |
| 17 | sleep(20); |
| 18 | |
| 19 | my $client = REST::Client->new(); |
| 20 | $client->GET('http://localhost:3000/?word=Grund&json=1'); |
| 21 | $res = decode_json($client->responseContent()); |
| 22 | is( $res->{list}->[0]->[1]->{word}, "Reaktion", "primary paradigmatic neighbour of Grund" ); |
| 23 | is( $res->{collocators}->[0]->{word}, "Hitchcock", "primary syntagmatic neighbour of Grund" ); |
| 24 | |
| Marc Kupietz | 565274e | 2026-09-06 13:17:17 +0200 | [diff] [blame] | 25 | # "König - Mann + Frau": the neighbours of a position that belongs to no |
| 26 | # single word, and no syntagmatic answer for it. |
| 27 | $client->GET('http://localhost:3000/?word=K%C3%B6nig+-+Mann+%2B+Frau&json=1'); |
| 28 | $res = decode_json($client->responseContent()); |
| 29 | is( $res->{list}->[0]->[0]->{word}, "Dareios", "primary neighbour of a vector expression" ); |
| 30 | ok( $res->{collocators} && @{$res->{collocators}} > 0, "a vector expression has syntagmatic neighbours too" ); |
| 31 | |
| 32 | # The syntagmatic side used to read the input weights of the first operand |
| 33 | # alone: "Haus Auto" answered with the collocators of "Haus", "Auto Haus" with |
| 34 | # those of "Auto". It combines them now, so the order no longer matters and |
| 35 | # neither single word answer comes back unchanged. |
| 36 | $client->GET('http://localhost:3000/?word=Haus&json=1'); |
| 37 | my $haus = decode_json($client->responseContent()); |
| 38 | $client->GET('http://localhost:3000/?word=Haus+Auto&json=1'); |
| 39 | my $haus_auto = decode_json($client->responseContent()); |
| 40 | $client->GET('http://localhost:3000/?word=Auto+Haus&json=1'); |
| 41 | my $auto_haus = decode_json($client->responseContent()); |
| 42 | is_deeply( [map { $_->{word} } @{$haus_auto->{collocators}}], |
| 43 | [map { $_->{word} } @{$auto_haus->{collocators}}], |
| 44 | "the syntagmatic side does not depend on the order of the operands" ); |
| 45 | isnt( $haus_auto->{collocators}->[0]->{max}, $haus->{collocators}->[0]->{max}, |
| 46 | "and combines them rather than answering for the first" ); |
| 47 | |
| 48 | $client->GET('http://localhost:3000/?word=Grund+Blahfasel&json=1'); |
| 49 | $res = decode_json($client->responseContent()); |
| 50 | is( $res->{unknown}, "Blahfasel", "operands outside the vocabulary are reported" ); |
| 51 | |
| Marc Kupietz | 3e3e326 | 2022-04-12 23:11:45 +0200 | [diff] [blame] | 52 | $client->GET('http://localhost:3000/getClassicCollocators?w=Grund'); |
| 53 | #print STDERR dump($res); |
| 54 | $res = decode_json($client->responseContent()); |
| 55 | is( $res->{collocates}->[0]->{word}, "diesem", "primary collocate of Grund" ); |
| 56 | |
| 57 | $client->GET('http://localhost:3000/getClassicCollocators?w=Grund'); |
| 58 | $res = decode_json($client->responseContent()); |
| 59 | is( $res->{collocates}->[0]->{word}, "diesem", "primary collocate of Grund (cached)" ); |
| 60 | |
| 61 | $client->GET('http://localhost:3000/getCollocationAssociation?w=Grund&c=diesem'); |
| 62 | $res = decode_json($client->responseContent()); |
| 63 | is($res->{f1}, 29, "collocation association"); |
| 64 | |
| Marc Kupietz | af708c2 | 2023-11-05 11:20:20 +0100 | [diff] [blame] | 65 | $client->GET('http://localhost:3000/getVersion'); |
| 66 | $res = $client->responseContent(); |
| Marc Kupietz | b36bc74 | 2023-11-05 17:46:11 +0100 | [diff] [blame] | 67 | like($res, qr/^"\d+\.?\d*\.?\d*"$/, "version ok"); |
| Marc Kupietz | af708c2 | 2023-11-05 11:20:20 +0100 | [diff] [blame] | 68 | |
| Marc Kupietz | dea505e | 2023-11-05 11:42:36 +0100 | [diff] [blame] | 69 | $client->GET('http://localhost:3000/getModelName'); |
| 70 | $res = $client->responseContent(); |
| Marc Kupietz | b36bc74 | 2023-11-05 17:46:11 +0100 | [diff] [blame] | 71 | is($res, '"wpd19_10000"', "model name ok"); |
| 72 | |
| Marc Kupietz | 043db15 | 2023-11-05 17:47:53 +0100 | [diff] [blame] | 73 | $client->GET('http://localhost:3000/getVocabSize'); |
| 74 | $res = $client->responseContent(); |
| 75 | ok($res > 1000, "vocab size ok"); |
| Marc Kupietz | dea505e | 2023-11-05 11:42:36 +0100 | [diff] [blame] | 76 | |
| Marc Kupietz | 3e3e326 | 2022-04-12 23:11:45 +0200 | [diff] [blame] | 77 | for (my $i=0; $i<4; $i++) { |
| 78 | $pid++; |
| 79 | print STDERR "killing PID $pid\n"; |
| 80 | system("kill -9 $pid"); |
| 81 | } |
| 82 | done_testing; |