File 1701-New-shell-functions-pi-1-and-pi-3-instead-of-i-3.patch of Package erlang

From 49ae0195663dc11b46f830a2f9226f5ce70deaed Mon Sep 17 00:00:00 2001
From: Richard Carlsson <carlsson.richard@gmail.com>
Date: Sun, 30 Nov 2025 23:05:28 +0100
Subject: [PATCH] New shell functions `pi/1` and `pi/3` instead of `i/3`

Since the shell accepts the `<X.Y.Z>` syntax for pids, it was
surprising that `i(X,Y,Z)` worked, but `i(<X.Y.Z>)` did not, so
you could not simply paste a pid. The name `i/1` was however in
use by an undocumented function, and furthermore, the `i/0` info
function produces a very different output from `i/3`, so we instead
introduce the new names `pi/1` and `pi/3`, deprecating `i/3`.

Example:
    1> pi(<0.90.0>).
    [{current_function,{c,pinfo,1}},
     {initial_call,{erlang,apply,2}},
     {status,running},
    ...
---
 lib/stdlib/src/c.erl             | 31 ++++++++++++++++++++++++++-----
 lib/stdlib/src/shell.erl         |  1 +
 lib/stdlib/src/shell_default.erl |  6 +++++-
 3 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index f61d921d0b..8972665260 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -47,7 +47,7 @@ commands.
 -export([help/0,lc/1,c/1,c/2,c/3,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0,
          y/1, y/2,
 	 lc_batch/0, lc_batch/1,
-	 i/3,pid/3,m/0,m/1,mm/0,lm/0,
+	 pi/1,pi/3,i/3,pid/3,m/0,m/1,mm/0,lm/0,
 	 bt/1, q/0,
      h/1,h/2,h/3,h1/1,h1/2,h1/3,ht/1,ht/2,ht/3,hcb/1,hcb/2,hcb/3,
 	 erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, uptime/0,
@@ -84,7 +84,7 @@ help() ->
                    "ht(Mod,Type,Arity) -- help about type with arity in module\n"
                    "help()     -- help info\n"
                    "i()        -- information about the system\n"
-                   "i(X,Y,Z)   -- information about pid <X,Y,Z>\n"
+                   "i(X,Y,Z)   -- deprecated alias for pi(X,Y,Z)\n"
                    "l(Module)  -- load or reload module\n"
                    "lc([File]) -- compile a list of Erlang modules\n"
                    "lm()       -- load all modified modules\n"
@@ -99,6 +99,8 @@ help() ->
                    "ni()       -- information about the networked system\n"
                    "nl(Module) -- load module on all nodes\n"
                    "nregs()    -- information about all registered processes\n"
+                   "pi(Pid)    -- information about process <Pid>\n"
+                   "pi(X,Y,Z)  -- information about pid <X,Y,Z>\n"
                    "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n"
                    "pwd()      -- print working directory\n"
                    "q()        -- quit - shorthand for init:stop()\n"
@@ -954,15 +956,34 @@ pid(X, Y, Z) ->
 		integer_to_list(Z) ++ ">").
 
 -doc """
-Displays information about a process, Equivalent to
-[`process_info(pid(X, Y, Z))`](`process_info/1`), but location transparent.
+Old alias for `pi(X, Y, Z)`. Note that the output of `i(X, Y, Z)` is
+very different from that of `i()`, so the new name is preferred.
 """.
 -spec i(X, Y, Z) -> [{atom(), term()}] when
       X :: non_neg_integer(),
       Y :: non_neg_integer(),
       Z :: non_neg_integer().
 
-i(X, Y, Z) -> pinfo(pid(X, Y, Z)).
+i(X, Y, Z) -> pi(X, Y, Z).
+
+-doc """
+Equivalent to `pi(pid(X, Y, Z))`.
+""".
+-spec pi(X, Y, Z) -> [{atom(), term()}] when
+      X :: non_neg_integer(),
+      Y :: non_neg_integer(),
+      Z :: non_neg_integer().
+
+pi(X, Y, Z) -> pi(pid(X, Y, Z)).
+
+-doc """
+Displays information about a process, Equivalent to
+[`process_info(Pid)`](`process_info/1`), but location transparent.
+""".
+-spec pi(Pid) -> [{atom(), term()}] when
+      Pid :: pid().
+
+pi(Pid) -> pinfo(Pid).
 
 -doc """
 This function is shorthand for `init:stop()`, that is, it causes the node to
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index f06055dbc1..177803730c 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -1584,6 +1584,7 @@ write_and_compile_module(PathToFile, Output) ->
         ok -> c:c(PathToFile);
         Error -> Error
     end.
+
 non_builtin_local_func(F,As,Bs, FT) ->
     Arity = length(As),
     case erlang:function_exported(user_default, F, Arity) of
diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl
index 00e1743f05..b100f62d31 100644
--- a/lib/stdlib/src/shell_default.erl
+++ b/lib/stdlib/src/shell_default.erl
@@ -59,7 +59,7 @@ code:load_abs("$PATH/user_default").
 `$PATH` is the directory where your `user_default` module can be found.
 """.
 
--export([help/0,lc/1,c/1,c/2,c/3,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0,
+-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nl/1,l/1,i/0,pid/3,i/3,pi/1,pi/3,m/0,m/1,lm/0,mm/0,
          memory/0,memory/1,uptime/0,
          erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1,
          y/1, y/2,
@@ -127,6 +127,10 @@ i()             -> c:i().
 -doc false.
 i(X,Y,Z)        -> c:i(X,Y,Z).
 -doc false.
+pi(X,Y,Z)        -> c:pi(X,Y,Z).
+-doc false.
+pi(Pid)          -> c:pi(Pid).
+-doc false.
 l(Mod)          -> c:l(Mod).
 -doc false.
 lc(X)           -> c:lc(X).
-- 
2.51.0

openSUSE Build Service is sponsored by