diff --git a/src/lib_context/context.ml b/src/lib_context/context.ml
index e6f1243304bc3b23e13d26e1c29a472bfb25e32d..e7717a138920cfd11bba507acf3c92345e0c56c8 100644
--- a/src/lib_context/context.ml
+++ b/src/lib_context/context.ml
@@ -368,7 +368,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct
   let list ctxt ?offset ?length key =
     Tree.list ctxt.tree ?offset ?length (data_key key)
 
-  let length ctxt key = Tree.length ctxt.tree key
+  let length ctxt key = Tree.length ctxt.tree (data_key key)
 
   let find ctxt key = raw_find ctxt (data_key key)
 
diff --git a/src/lib_context/memory/context.ml b/src/lib_context/memory/context.ml
index 2fa85b69888cd0a8e9751e709099a3ed9eec630f..7a17f9144272c322c1bd9571e25a7ff4da314903 100644
--- a/src/lib_context/memory/context.ml
+++ b/src/lib_context/memory/context.ml
@@ -170,7 +170,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct
   let list ctxt ?offset ?length key =
     Tree.list ctxt.tree ?offset ?length (data_key key)
 
-  let length ctxt key = Tree.length ctxt.tree key
+  let length ctxt key = Tree.length ctxt.tree (data_key key)
 
   let find ctxt key = Tree.find ctxt.tree (data_key key)
 
diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml
index c96b264c20f16801833d8edef73ef4c9feb490c3..971db8049272e79ae210331d534ae81e6c43b223 100644
--- a/src/proto_alpha/lib_protocol/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/raw_context.ml
@@ -1078,6 +1078,8 @@ let config ctxt = Context.config (context ctxt)
 
 module Proof = Context.Proof
 
+let length ctxt key = Context.length (context ctxt) key
+
 module Tree :
   Raw_context_intf.TREE
     with type t := t
diff --git a/src/proto_alpha/lib_protocol/raw_context_intf.ml b/src/proto_alpha/lib_protocol/raw_context_intf.ml
index d6ef0becd0e5e2cb3ec6118cbacb08c5be5e5231..39c8b058d78aa7a682d24b1d8e9095c4cb5a2645 100644
--- a/src/proto_alpha/lib_protocol/raw_context_intf.ml
+++ b/src/proto_alpha/lib_protocol/raw_context_intf.ml
@@ -185,6 +185,20 @@ module type VIEW = sig
 
   (** [config t] is [t]'s hash configuration. *)
   val config : t -> config
+
+  (** [length t key] is an Lwt promise that resolves to the number of files and
+      sub-nodes stored under [k] in [t].
+
+      It is equivalent to [list t k >|= List.length] but has a constant-time
+      complexity.
+
+      Most of the time, this function does not perform any I/O as the length is
+      cached in the tree. It may perform one read to load the root node of the
+      tree in case it has not been loaded already. The initial constant is the
+      same between [list] and [length]. They both perform the same kind of I/O
+      reads. While [list] usually performs a linear number of reads, [length]
+      does at most one. *)
+  val length : t -> key -> int Lwt.t
 end
 
 module Kind = struct
diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml
index 3c4d9bd4c3643b614039c5d337e7d31c52521042..df7cab1046745043533af9bc81f5d62a5d21945b 100644
--- a/src/proto_alpha/lib_protocol/storage_functors.ml
+++ b/src/proto_alpha/lib_protocol/storage_functors.ml
@@ -140,6 +140,8 @@ module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :
       if R.ghost then Storage_description.create () else C.description
     in
     Storage_description.register_named_subcontext description N.name
+
+  let length = C.length
 end
 
 module Make_single_data_storage
@@ -822,6 +824,10 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
       C.check_enough_gas t g
 
     let description = description
+
+    let length c =
+      let (t, _i) = unpack c in
+      C.length t
   end
 
   module Make_set (R : REGISTER) (N : NAME) :
diff --git a/src/proto_alpha/lib_protocol/test/integration/test_storage_functions.ml b/src/proto_alpha/lib_protocol/test/integration/test_storage_functions.ml
index c0fa687b72a7cfd3c72e7114084b1e647bc5aed0..96415c5a153275ee13c413d292238e45d413cfde 100644
--- a/src/proto_alpha/lib_protocol/test/integration/test_storage_functions.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/test_storage_functions.ml
@@ -35,6 +35,14 @@
 open Protocol
 open Storage_functors
 
+let assert_length ~loc ctxt key expected =
+  let open Lwt_result_syntax in
+  let*! length = Raw_context.length ctxt key in
+  let* () = Assert.equal_int ~loc length expected in
+  let*! list = Raw_context.list ctxt key in
+  let list_length = List.length list in
+  Assert.equal_int ~loc length list_length
+
 module Int32 = struct
   type t = int32
 
@@ -117,10 +125,55 @@ let test_fold_keys_unaccounted () =
     [1; 2]
     items
 
+(** Test that [length] returns the number of elements for a given path. *)
+let test_length () =
+  let open Lwt_result_syntax in
+  let* ctxt = Context.default_raw_context () in
+  (* Add a tree to the context:
+     root:
+       left:
+         l1 : V1
+         l2 : V2
+         l3 : V3
+       right:
+         r1 : V4
+         r2 : V5
+       file : V6
+  *)
+  let*! tree =
+    let*! tree_left =
+      let tree = Raw_context.Tree.empty ctxt in
+      let*! tree = Raw_context.Tree.add tree ["l1"] (Bytes.of_string "V1") in
+      let*! tree = Raw_context.Tree.add tree ["l2"] (Bytes.of_string "V2") in
+      Raw_context.Tree.add tree ["c"] (Bytes.of_string "V3")
+    in
+    let*! tree_right =
+      let tree = Raw_context.Tree.empty ctxt in
+      let*! tree = Raw_context.Tree.add tree ["r1"] (Bytes.of_string "V4") in
+      Raw_context.Tree.add tree ["r2"] (Bytes.of_string "V5")
+    in
+    let tree = Raw_context.Tree.empty ctxt in
+    let*! tree = Raw_context.Tree.add_tree tree ["left"] tree_left in
+    let*! tree = Raw_context.Tree.add_tree tree ["right"] tree_right in
+    Raw_context.Tree.add tree ["file"] (Bytes.of_string "V6")
+  in
+  let* ctxt = wrap @@ Raw_context.init_tree ctxt ["root"] tree in
+  (* The root node contains 3 elements. *)
+  let* () = assert_length ctxt ~loc:__LOC__ ["root"] 3 in
+  (* The left branch contains 3 elements. *)
+  let* () = assert_length ctxt ~loc:__LOC__ ["root"; "left"] 3 in
+  (* The right branch contains 2 elements. *)
+  let* () = assert_length ctxt ~loc:__LOC__ ["root"; "right"] 2 in
+  (* Path [root/left/l1] is a leaf and thus returns length 0. *)
+  let* () = assert_length ctxt ~loc:__LOC__ ["root"; "left"; "l1"] 0 in
+  (* The length of a non-existing path also returns 0. *)
+  assert_length ctxt ~loc:__LOC__ ["root"; "right"; "non_existing"] 0
+
 let tests =
   [
     Tztest.tztest
       "fold_keys_unaccounted smoke test"
       `Quick
       test_fold_keys_unaccounted;
+    Tztest.tztest "length test" `Quick test_length;
   ]