From 3620b8d9cdc5e9fee139eaa8dbb90e4a9a018ff1 Mon Sep 17 00:00:00 2001
From: Steve Linton <steve.linton@st-andrews.ac.uk>
Date: Sat, 4 May 2019 14:40:01 +0100
Subject: [PATCH] Make SubdirectProductOp handle mappings which do not know
 they are homomorphisms Fixes #3431 Also introduce a family predicare for
 SubdirectProductOp for robustness

---
 lib/gprd.gi     | 22 ++++++++++++++++------
 lib/gprdpc.gi   |  2 +-
 lib/gprdperm.gi |  2 +-
 3 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/lib/gprd.gi b/lib/gprd.gi
index 191d5e824bd..6f1e6463604 100644
--- a/lib/gprd.gi
+++ b/lib/gprd.gi
@@ -510,11 +510,6 @@ local iso;
     fi;
   fi;
 
-  # the ...Op is installed for `IsGroupHomomorphism'. So we have to enforce
-  # the filter to be set.
-  if not IsGroupHomomorphism(ghom) or not IsGroupHomomorphism(hhom) then
-    Error("mappings are not homomorphisms");
-  fi;
   return SubdirectProductOp(G,H,ghom,hhom);
 end);
 
@@ -522,7 +517,22 @@ end);
 ##
 #M  SubdirectProduct( <G1>, <G2>, <phi1>, <phi2> )
 ##
-InstallMethod( SubdirectProductOp,"groups", true,
+
+BindGlobal("SubdirectProductFamilyPredicate",{F1, F2, F3, F4} ->
+        IsGeneralMappingFamily(F3) and IsGeneralMappingFamily(F4) and
+        IsIdenticalObj(FamilySource(F3), ElementsFamily(F1)) and 
+        IsIdenticalObj(FamilySource(F4), ElementsFamily(F2)) and 
+        IsIdenticalObj(FamilyRange(F3), FamilyRange(F4)));
+
+
+RedispatchOnCondition(SubdirectProductOp, "check mappings", 
+        SubdirectProductFamilyPredicate, 
+        [IsGroup, IsGroup, IsGeneralMapping, IsGeneralMapping],
+        [IsObject, IsObject, IsGroupHomomorphism, IsGroupHomomorphism],
+        10);
+
+   
+InstallMethod( SubdirectProductOp,"groups", SubdirectProductFamilyPredicate,
   [ IsGroup, IsGroup, IsGroupHomomorphism, IsGroupHomomorphism ], 0,
 function( G, H, gh, hh )
 local gc,hc,S,info;
diff --git a/lib/gprdpc.gi b/lib/gprdpc.gi
index 5f20c6c6f5a..adced138ab7 100644
--- a/lib/gprdpc.gi
+++ b/lib/gprdpc.gi
@@ -410,7 +410,7 @@ end);
 ##
 #M  SubdirectProduct( <G1>, <G2>, <phi1>, <phi2> )
 ##
-InstallMethod( SubdirectProductOp,"pcgroup", true,
+InstallMethod( SubdirectProductOp,"pcgroup", SubdirectProductFamilyPredicate,
   [ IsPcGroup, IsPcGroup, IsGroupHomomorphism, IsGroupHomomorphism ], 0,
 function( G, H, gh, hh )
 local pg,ph,kg,kh,ig,ih,mg,mh,S,info;
diff --git a/lib/gprdperm.gi b/lib/gprdperm.gi
index 06ad52aa730..3f8616abe92 100644
--- a/lib/gprdperm.gi
+++ b/lib/gprdperm.gi
@@ -355,7 +355,7 @@ end);
 ##
 #M  SubdirectProduct( <G1>, <G2>, <phi1>, <phi2> )  . . . . . . . constructor
 ##
-InstallMethod( SubdirectProductOp,"permgroup", true,
+InstallMethod( SubdirectProductOp,"permgroup", SubdirectProductFamilyPredicate,
   [ IsPermGroup, IsPermGroup, IsGroupHomomorphism, IsGroupHomomorphism ], 0,
     function( G1, G2, phi1, phi2 )
     local   S,          # subdirect product of <G1> and <G2>, result