var
   list:array[0..200,0..3] of integer;
   word:array[1..6] of string;
   str,ss:string;
   n,t,s:integer;

function work(str:string):integer;
var
   tot,i,j,l:integer;
   st:string;
   used:array[1..200] of boolean;
begin
   tot:=0;
   fillchar(used,sizeof(used),false);
   for i:=1 to s do begin
      st:=str;
      l:=0;
      j:=pos(word[i],st);
      while j<>0 do begin
         if not used[l+j] then inc(tot);
         delete(st,1,j);
         used[l+j]:=true;
         l:=l+j;
         j:=pos(word[i],st);
         end;
      end;
   work:=tot;
end;

procedure solve;
var
   i,j,p,k,l,u:integer;
begin
   readln(p,k);
   str:='';
   for i:=1 to p do begin
      readln(ss);
      str:=str+ss;
      end;
   readln(s);
   for i:=1 to s do readln(word[i]);
   fillchar(list,sizeof(list),0);
   for i:=1 to 20*p do
      for j:=1 to k do
         for u:=j to i do begin
            l:=work(copy(str,u,i-u+1));
            if list[u-1,j-1]+l>list[i,j] then list[i,j]:=list[u-1,j-1]+l;
            end;
   writeln(list[20*p,k]);
end;

begin
   assign(input,'input3.dat'); reset(input);
   readln(n);
   for t:=1 to n do solve;
end.