Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / unix / groups / groups.factor

diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor
index 41cd80f456ccf3e5f93c839600ee43fba51cefe8..eba0e4976f40e7927e61ae7c02e76e15752b48b4 100644 (file)
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@@ -13,7 +13,7 @@ TUPLE: group id name passwd members ;
 
 SYMBOL: group-cache
 
-GENERIC: group-struct ( obj -- group )
+GENERIC: group-struct ( obj -- group/f )
 
 <PRIVATE
 
@@ -24,11 +24,14 @@ GENERIC: group-struct ( obj -- group )
     "group" <c-object> tuck 4096
     [ <byte-array> ] keep f <void*> ;
 
-M: integer group-struct ( id -- group )
-    (group-struct) getgrgid_r io-error ;
+: check-group-struct ( group-struct ptr -- group-struct/f )
+    *void* [ drop f ] unless ;
 
-M: string group-struct ( string -- group )
-    (group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
+M: integer group-struct ( id -- group/f )
+    (group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
+
+M: string group-struct ( string -- group/f )
+    (group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
 
 : group-struct>group ( group-struct -- group )
     [ \ group new ] dip
@@ -43,14 +46,14 @@ PRIVATE>
 
 : group-name ( id -- string )
     dup group-cache get [
-        dupd at* [ name>> nip ] [ drop number>string ] if
+        ?at [ name>> ] [ number>string ] if
     ] [
-        group-struct group-gr_name
+        group-struct [ group-gr_name ] [ f ] if*
     ] if*
     [ nip ] [ number>string ] if* ;
 
-: group-id ( string -- id )
-    group-struct group-gr_gid ;
+: group-id ( string -- id/f )
+    group-struct [ group-gr_gid ] [ f ] if* ;
 
 <PRIVATE
 
@@ -61,7 +64,7 @@ PRIVATE>
     #! first group is -1337, legacy unix code
     -1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
     <int> [ getgrouplist io-error ] 2keep
-    [ 4 tail-slice ] [ *int 1- ] bi* >groups ;
+    [ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
 
 PRIVATE>
     
@@ -71,10 +74,10 @@ M: string user-groups ( string -- seq )
     (user-groups) ; 
 
 M: integer user-groups ( id -- seq )
-    username (user-groups) ;
+    user-name (user-groups) ;
     
 : all-groups ( -- seq )
-    [ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
+    [ getgrent dup ] [ group-struct>group ] produce nip ;
 
 : <group-cache> ( -- assoc )
     all-groups [ [ id>> ] keep ] H{ } map>assoc ;