aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/doc/src/erlc.xml2
-rw-r--r--erts/emulator/beam/erl_binary.h1
-rw-r--r--erts/emulator/beam/erl_db_catree.c280
-rw-r--r--erts/emulator/beam/erl_db_catree.h4
-rw-r--r--lib/kernel/src/logger.erl10
-rw-r--r--lib/kernel/src/logger_internal.hrl7
-rw-r--r--lib/kernel/test/logger_SUITE.erl2
-rw-r--r--lib/ssl/test/ssl_api_SUITE.erl6
-rw-r--r--lib/ssl/test/ssl_session_cache_SUITE.erl4
-rw-r--r--lib/ssl/test/tls_api_SUITE.erl6
-rw-r--r--lib/stdlib/src/filelib.erl32
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl34
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl48
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl38
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl3
15 files changed, 284 insertions, 193 deletions
diff --git a/erts/doc/src/erlc.xml b/erts/doc/src/erlc.xml
index be9b4e8d97..62957d6a50 100644
--- a/erts/doc/src/erlc.xml
+++ b/erts/doc/src/erlc.xml
@@ -42,7 +42,7 @@
Regardless of which compiler is used, the same flags are used to provide
parameters, such as include paths and output directory.</p>
<p>The current working directory, <c>"."</c>, is not included
- in the code path when running the compiler. This to avoid loading
+ in the code path when running the compiler. This is to avoid loading
Beam files from the current working directory that could potentially
be in conflict with the compiler or the Erlang/OTP system used by the
compiler.</p>
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 66b59ef1a3..f5a35f2222 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -311,6 +311,7 @@ ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf);
ERTS_GLB_INLINE void erts_free_aligned_binary_bytes_extra(byte* buf, ErtsAlcType_t);
ERTS_GLB_INLINE Binary *erts_bin_drv_alloc_fnf(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_drv_alloc(Uint size);
+ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc_fnf(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_realloc_fnf(Binary *bp, Uint size);
ERTS_GLB_INLINE Binary *erts_bin_realloc(Binary *bp, Uint size);
diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c
index 8a89eb72df..2d213baa25 100644
--- a/erts/emulator/beam/erl_db_catree.c
+++ b/erts/emulator/beam/erl_db_catree.c
@@ -90,9 +90,9 @@
** Forward declarations
*/
-static SWord do_free_base_node_cont(DbTableCATree *tb, SWord num_left);
-static SWord do_free_routing_nodes_catree_cont(DbTableCATree *tb, SWord num_left);
-static DbTableCATreeNode *catree_first_base_node_from_free_list(DbTableCATree *tb);
+static SWord do_delete_base_node_cont(DbTableCATree *tb,
+ DbTableCATreeNode *base_node,
+ SWord num_left);
/* Method interface functions */
static int db_first_catree(Process *p, DbTable *tbl,
@@ -1364,113 +1364,152 @@ static void split_catree(DbTableCATree *tb,
}
}
-/*
- * Helper functions for removing the table
+/* @brief Free the entire catree and its sub-trees.
+ *
+ * @param reds Reductions to spend.
+ * @return Reductions left. Negative value if not done.
*/
-
-static void catree_add_base_node_to_free_list(
- DbTableCATree *tb,
- DbTableCATreeNode *base_node_container)
+static SWord db_free_table_continue_catree(DbTable *tbl, SWord reds)
{
- base_node_container->u.base.next =
- tb->base_nodes_to_free_list;
- tb->base_nodes_to_free_list = base_node_container;
-}
+ DbTableCATree *tb = &tbl->catree;
+ DbTableCATreeNode *node;
+ DbTableCATreeNode *parent;
+ CATreeNodeStack rnode_stack;
+ DbTableCATreeNode *rnode_stack_array[STACK_NEED];
-static void catree_deque_base_node_from_free_list(DbTableCATree *tb)
-{
- if (tb->base_nodes_to_free_list == NULL) {
- return; /* List empty */
- } else {
- DbTableCATreeNode *first = tb->base_nodes_to_free_list;
- tb->base_nodes_to_free_list = first->u.base.next;
+ if (!tb->deletion) {
+ /* First call */
+ tb->deletion = 1;
+ tb->nr_of_deleted_items = 0;
}
-}
-static DbTableCATreeNode *catree_first_base_node_from_free_list(
- DbTableCATree *tb)
-{
- return tb->base_nodes_to_free_list;
-}
+ /*
+ * The route tree is traversed and freed while keeping it consistent
+ * during yields.
+ */
+ rnode_stack.array = rnode_stack_array;
+ rnode_stack.pos = 0;
+ rnode_stack.size = STACK_NEED;
-static SWord do_free_routing_nodes_catree_cont(DbTableCATree *tb, SWord num_left)
-{
- DbTableCATreeNode *root;
- DbTableCATreeNode *p;
- for (;;) {
- root = POP_NODE(&tb->free_stack_rnodes);
- if (root == NULL) break;
- else if(root->is_base_node) {
- catree_add_base_node_to_free_list(tb, root);
- break;
+ node = GET_ROOT(tb);
+ if (node->is_base_node) {
+ if (node->u.base.root) {
+ reds = do_delete_base_node_cont(tb, node, reds);
+ if (reds < 0)
+ return reds; /* Yield */
}
- for (;;) {
- if ((GET_LEFT(root) != NULL) &&
- (p = GET_LEFT(root))->is_base_node) {
- SET_LEFT(root, NULL);
- catree_add_base_node_to_free_list(tb, p);
- } else if ((GET_RIGHT(root) != NULL) &&
- (p = GET_RIGHT(root))->is_base_node) {
- SET_RIGHT(root, NULL);
- catree_add_base_node_to_free_list(tb, p);
- } else if ((p = GET_LEFT(root)) != NULL) {
- SET_LEFT(root, NULL);
- PUSH_NODE(&tb->free_stack_rnodes, root);
- root = p;
- } else if ((p = GET_RIGHT(root)) != NULL) {
- SET_RIGHT(root, NULL);
- PUSH_NODE(&tb->free_stack_rnodes, root);
- root = p;
- } else {
- free_catree_route_node(tb, root);
- if (--num_left >= 0) {
+ free_catree_base_node(tb, node);
+ }
+ else {
+ for (;;) {
+ DbTableCATreeNode* left = GET_LEFT(node);
+ DbTableCATreeNode* right = GET_RIGHT(node);
+
+ if (!left->is_base_node) {
+ PUSH_NODE(&rnode_stack, node);
+ node = left;
+ }
+ else if (!right->is_base_node) {
+ PUSH_NODE(&rnode_stack, node);
+ node = right;
+ }
+ else {
+ if (left->u.base.root) {
+ reds = do_delete_base_node_cont(tb, left, reds);
+ if (reds < 0)
+ return reds; /* Yield */
+ }
+ if (right->u.base.root) {
+ reds = do_delete_base_node_cont(tb, right, reds);
+ if (reds < 0)
+ return reds; /* Yield */
+ }
+
+ free_catree_base_node(tb, right);
+ free_catree_route_node(tb, node);
+ /*
+ * Keep empty left base node to join with its grandparent
+ * for tree consistency during yields.
+ */
+
+ parent = POP_NODE(&rnode_stack);
+ if (parent) {
+ if (node == GET_LEFT(parent)) {
+ SET_LEFT(parent, left);
+ }
+ else {
+ ASSERT(node == GET_RIGHT(parent));
+ SET_RIGHT(parent, left);
+ }
+
+ reds -= 2;
+ if (reds < 0)
+ return reds; /* Yield */
+
+ node = parent;
+ }
+ else { /* Done */
+ free_catree_base_node(tb, left);
break;
- } else {
- return num_left; /* Done enough for now */
}
}
}
}
- return num_left;
+
+ ASSERT(reds >= 0);
+ SET_ROOT(tb, NULL);
+ return reds;
}
-static SWord do_free_base_node_cont(DbTableCATree *tb, SWord num_left)
+/* @brief Free all objects of a base node, but keep the base node.
+ *
+ * @param reds Reductions to spend.
+ * @return Reductions left. Negative value if not done.
+ */
+static SWord do_delete_base_node_cont(DbTableCATree *tb,
+ DbTableCATreeNode *base_node,
+ SWord reds)
{
- TreeDbTerm *root;
TreeDbTerm *p;
- DbTableCATreeNode *base_node_container =
- catree_first_base_node_from_free_list(tb);
+ DbTreeStack stack;
+ TreeDbTerm* stack_array[STACK_NEED];
+
+ stack.pos = 0;
+ stack.array = stack_array;
+
+ p = base_node->u.base.root;
for (;;) {
- root = POP_NODE(&tb->free_stack_elems);
- if (root == NULL) break;
- for (;;) {
- if ((p = root->left) != NULL) {
- root->left = NULL;
- PUSH_NODE(&tb->free_stack_elems, root);
- root = p;
- } else if ((p = root->right) != NULL) {
- root->right = NULL;
- PUSH_NODE(&tb->free_stack_elems, root);
- root = p;
- } else {
- DEC_NITEMS((DbTable*)tb);
- tb->nr_of_deleted_items++;
- free_term((DbTable*)tb, root);
- if (--num_left >= 0) {
- break;
- } else {
- return num_left; /* Done enough for now */
- }
+ if (p->left) {
+ PUSH_NODE(&stack, p);
+ p = p->left;
+ }
+ else if (p->right) {
+ PUSH_NODE(&stack, p);
+ p = p->right;
+ }
+ else {
+ TreeDbTerm *parent;
+
+ DEC_NITEMS((DbTable*)tb);
+ tb->nr_of_deleted_items++;
+ free_term((DbTable*)tb, p);
+
+ parent = POP_NODE(&stack);
+ if (!parent)
+ break;
+ if (parent->left == p)
+ parent->left = NULL;
+ else {
+ ASSERT(parent->right == p);
+ parent->right = NULL;
}
+ if (--reds < 0)
+ return reds; /* Yield */
+ p = parent;
}
}
- catree_deque_base_node_from_free_list(tb);
- free_catree_base_node(tb, base_node_container);
- base_node_container = catree_first_base_node_from_free_list(tb);
- if (base_node_container != NULL) {
- PUSH_NODE(&tb->free_stack_elems, base_node_container->u.base.root);
- }
- return num_left;
+ base_node->u.base.root = NULL;
+ return reds;
}
@@ -1494,7 +1533,6 @@ int db_create_catree(Process *p, DbTable *tbl)
root = create_base_node(tb, NULL);
tb->deletion = 0;
- tb->base_nodes_to_free_list = NULL;
tb->nr_of_deleted_items = 0;
#ifdef DEBUG
tbl->common.status |= DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN;
@@ -2131,57 +2169,6 @@ static int db_free_table_catree(DbTable *tbl)
return 1;
}
-static SWord db_free_table_continue_catree(DbTable *tbl, SWord reds)
-{
- DbTableCATreeNode *first_base_node;
- DbTableCATree *tb = &tbl->catree;
- if (!tb->deletion) {
- tb->deletion = 1;
- tb->free_stack_elems.array =
- erts_db_alloc(ERTS_ALC_T_DB_STK,
- (DbTable *) tb,
- sizeof(TreeDbTerm *) * STACK_NEED);
- tb->free_stack_elems.pos = 0;
- tb->free_stack_elems.slot = 0;
- tb->free_stack_rnodes.array =
- erts_db_alloc(ERTS_ALC_T_DB_STK,
- (DbTable *) tb,
- sizeof(DbTableCATreeNode *) * STACK_NEED);
- tb->free_stack_rnodes.pos = 0;
- tb->free_stack_rnodes.size = STACK_NEED;
- PUSH_NODE(&tb->free_stack_rnodes, GET_ROOT(tb));
- tb->is_routing_nodes_freed = 0;
- tb->base_nodes_to_free_list = NULL;
- tb->nr_of_deleted_items = 0;
- }
- if ( ! tb->is_routing_nodes_freed ) {
- reds = do_free_routing_nodes_catree_cont(tb, reds);
- if (reds < 0) {
- return reds; /* Not finished */
- } else {
- tb->is_routing_nodes_freed = 1; /* Ready with the routing nodes */
- first_base_node = catree_first_base_node_from_free_list(tb);
- PUSH_NODE(&tb->free_stack_elems, first_base_node->u.base.root);
- }
- }
- while (catree_first_base_node_from_free_list(tb) != NULL) {
- reds = do_free_base_node_cont(tb, reds);
- if (reds < 0) {
- return reds; /* Continue later */
- }
- }
- /* Time to free the main structure*/
- erts_db_free(ERTS_ALC_T_DB_STK,
- (DbTable *) tb,
- (void *) tb->free_stack_elems.array,
- sizeof(TreeDbTerm *) * STACK_NEED);
- erts_db_free(ERTS_ALC_T_DB_STK,
- (DbTable *) tb,
- (void *) tb->free_stack_rnodes.array,
- sizeof(DbTableCATreeNode *) * STACK_NEED);
- return 1;
-}
-
static
int db_catree_nr_of_items_deleted_wb_dtor(Binary *context_bin) {
(void)context_bin;
@@ -2258,10 +2245,15 @@ static void db_foreach_offheap_catree(DbTable *tbl,
void (*func)(ErlOffHeap *, void *),
void *arg)
{
+ DbTableCATree* tb = &tbl->catree;
CATreeRootIterator iter;
TreeDbTerm** root;
- init_root_iterator(&tbl->catree, &iter, 1);
+ if (!GET_ROOT(tb)) {
+ ASSERT(tb->common.status & DB_DELETE);
+ return;
+ }
+ init_root_iterator(tb, &iter, 1);
root = catree_find_first_root(&iter);
do {
db_foreach_offheap_tree_common(*root, func, arg);
@@ -2269,7 +2261,7 @@ static void db_foreach_offheap_catree(DbTable *tbl,
} while (root);
destroy_root_iterator(&iter);
- do_for_route_nodes(GET_ROOT(&tbl->catree), func, arg);
+ do_for_route_nodes(GET_ROOT(tb), func, arg);
}
static int db_lookup_dbterm_catree(Process *p, DbTable *tbl, Eterm key, Eterm obj,
diff --git a/erts/emulator/beam/erl_db_catree.h b/erts/emulator/beam/erl_db_catree.h
index 2ede85e04e..00141ef86d 100644
--- a/erts/emulator/beam/erl_db_catree.h
+++ b/erts/emulator/beam/erl_db_catree.h
@@ -46,7 +46,6 @@ typedef struct {
int is_valid; /* If this base node is still valid */
TreeDbTerm *root; /* The root of the sequential tree */
ErtsThrPrgrLaterOp free_item; /* Used when freeing using thread progress */
- struct DbTableCATreeNode * next; /* Used when gradually deleting */
char end_of_struct__;
} DbTableCATreeBaseNode;
@@ -83,9 +82,6 @@ typedef struct db_table_catree {
/* CA Tree-specific fields */
erts_atomic_t root; /* The tree root (DbTableCATreeNode*) */
Uint deletion; /* Being deleted */
- DbTreeStack free_stack_elems;/* Used for deletion ...*/
- CATreeNodeStack free_stack_rnodes;
- DbTableCATreeNode *base_nodes_to_free_list;
int is_routing_nodes_freed;
/* The fields below are used by delete_all_objects and
select_delete(DeleteAll)*/
diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl
index 38bd2f481c..fd02cf67bf 100644
--- a/lib/kernel/src/logger.erl
+++ b/lib/kernel/src/logger.erl
@@ -600,11 +600,11 @@ get_module_level() ->
%%%-----------------------------------------------------------------
%%% Misc
-spec compare_levels(Level1,Level2) -> eq | gt | lt when
- Level1 :: level(),
- Level2 :: level().
-compare_levels(Level,Level) when ?IS_LEVEL(Level) ->
+ Level1 :: level() | all | none,
+ Level2 :: level() | all | none.
+compare_levels(Level,Level) when ?IS_LEVEL_ALL(Level) ->
eq;
-compare_levels(Level1,Level2) when ?IS_LEVEL(Level1), ?IS_LEVEL(Level2) ->
+compare_levels(Level1,Level2) when ?IS_LEVEL_ALL(Level1), ?IS_LEVEL_ALL(Level2) ->
Int1 = logger_config:level_to_int(Level1),
Int2 = logger_config:level_to_int(Level2),
if Int1 < Int2 -> gt;
@@ -950,7 +950,7 @@ get_logger_type(Env) ->
get_logger_level() ->
case application:get_env(kernel,logger_level,info) of
- Level when ?IS_LEVEL(Level); Level=:=all; Level=:=none ->
+ Level when ?IS_LEVEL_ALL(Level) ->
Level;
Level ->
throw({logger_level, Level})
diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl
index e53922e5d3..c2b2d419e7 100644
--- a/lib/kernel/src/logger_internal.hrl
+++ b/lib/kernel/src/logger_internal.hrl
@@ -86,7 +86,12 @@
L=:=warning orelse
L=:=notice orelse
L=:=info orelse
- L=:=debug)).
+ L=:=debug )).
+
+-define(IS_LEVEL_ALL(L),
+ ?IS_LEVEL(L) orelse
+ L=:=all orelse
+ L=:=none ).
-define(IS_MSG(Msg),
((is_tuple(Msg) andalso tuple_size(Msg)==2)
diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl
index 035e5d8974..f8f3d27778 100644
--- a/lib/kernel/test/logger_SUITE.erl
+++ b/lib/kernel/test/logger_SUITE.erl
@@ -880,7 +880,7 @@ other_node(cleanup,_Config) ->
ok.
compare_levels(_Config) ->
- Levels = [emergency,alert,critical,error,warning,notice,info,debug],
+ Levels = [none,emergency,alert,critical,error,warning,notice,info,debug,all],
ok = compare(Levels),
{error,badarg} = ?TRY(logger:compare_levels(bad,bad)),
{error,badarg} = ?TRY(logger:compare_levels({bad},notice)),
diff --git a/lib/ssl/test/ssl_api_SUITE.erl b/lib/ssl/test/ssl_api_SUITE.erl
index fefecc0b65..14e5024b91 100644
--- a/lib/ssl/test/ssl_api_SUITE.erl
+++ b/lib/ssl/test/ssl_api_SUITE.erl
@@ -1251,8 +1251,9 @@ der_input(Config) when is_list(Config) ->
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
[CADb | _] = element(6, State),
-
+ ct:sleep(?SLEEP*2), %%Make sure there is no outstanding clean cert db msg in manager
Size = ets:info(CADb, size),
+ ct:pal("Size ~p", [Size]),
SeverVerifyOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} |
@@ -1281,6 +1282,7 @@ der_input(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, ok, Client, ok),
ssl_test_lib:close(Server),
ssl_test_lib:close(Client),
+ %% Using only DER input should not increase file indexed DB
Size = ets:info(CADb, size).
%%--------------------------------------------------------------------
@@ -1902,7 +1904,7 @@ do_recv_close(Socket) ->
tls_close(Socket) ->
ok = ssl_test_lib:send_recv_result(Socket),
- case ssl:close(Socket, 5000) of
+ case ssl:close(Socket, 10000) of
ok ->
ok;
{error, closed} ->
diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl
index b71b15b028..553c2d247b 100644
--- a/lib/ssl/test/ssl_session_cache_SUITE.erl
+++ b/lib/ssl/test/ssl_session_cache_SUITE.erl
@@ -28,7 +28,7 @@
-include_lib("common_test/include/ct.hrl").
-define(DELAY, 500).
--define(SLEEP, 500).
+-define(SLEEP, 1000).
-define(TIMEOUT, 60000).
-define(LONG_TIMEOUT, 600000).
-define(MAX_TABLE_SIZE, 5).
@@ -207,7 +207,7 @@ session_cleanup(Config) when is_list(Config) ->
end,
%% Make sure session is registered
- ct:sleep(?SLEEP),
+ ct:sleep(?SLEEP*2),
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
diff --git a/lib/ssl/test/tls_api_SUITE.erl b/lib/ssl/test/tls_api_SUITE.erl
index 5a74ec1892..7239d4cb90 100644
--- a/lib/ssl/test/tls_api_SUITE.erl
+++ b/lib/ssl/test/tls_api_SUITE.erl
@@ -794,16 +794,16 @@ tls_downgrade_result(Socket, Pid) ->
{tcp, TCPSocket, <<"Downgraded">>} ->
ok;
{tcp_closed, TCPSocket} ->
- ct:fail("Peer timed out, downgrade aborted"),
+ ct:fail("Did not receive TCP data"),
ok;
Other ->
{error, Other}
end;
{error, timeout} ->
- ct:fail("Timed out, downgrade aborted"),
+ ct:comment("Timed out, downgrade aborted"),
ok;
Fail ->
- {error, Fail}
+ ct:fail(Fail)
end.
tls_shutdown_result(Socket, server) ->
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index de839be5cf..d1a5a4dc35 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -281,6 +281,14 @@ do_wildcard_2([], _, Result, _Mod) ->
do_wildcard_3(Base, [[double_star]|Rest], Result, Mod) ->
do_double_star(".", [Base], Rest, Result, Mod, true);
+do_wildcard_3(Base, [".."|Rest], Result, Mod) ->
+ case do_is_dir(Base, Mod) of
+ true ->
+ Matches = [filename:join(Base, "..")],
+ do_wildcard_2(Matches, Rest, Result, Mod);
+ false ->
+ Result
+ end;
do_wildcard_3(Base0, [Pattern|Rest], Result, Mod) ->
case do_list_dir(Base0, Mod) of
{ok, Files} ->
@@ -387,15 +395,29 @@ compile_wildcard(Pattern0, Cwd0) ->
end.
compile_wildcard_2([Part|Rest], Root) ->
- case compile_part(Part) of
- Part ->
- compile_wildcard_2(Rest, compile_join(Root, Part));
- Pattern ->
- compile_wildcard_3(Rest, [Pattern,Root])
+ Pattern = compile_part(Part),
+ case is_literal_pattern(Pattern) of
+ true ->
+ %% Add this literal pattern to the literal pattern prefix.
+ %% This is an optimization to avoid listing all files of
+ %% a directory only to discard all but one. For example,
+ %% without this optimizaton, there would be three
+ %% redundant directory listings when executing this
+ %% wildcard: "./lib/compiler/ebin/*.beam"
+ compile_wildcard_2(Rest, compile_join(Root, Pattern));
+ false ->
+ %% This is the end of the literal prefix. Compile the
+ %% rest of the pattern.
+ compile_wildcard_3(Rest, [Pattern,Root])
end;
compile_wildcard_2([], {root,PrefixLen,Root}) ->
{{exists,Root},PrefixLen}.
+is_literal_pattern([H|T]) ->
+ is_integer(H) andalso is_literal_pattern(T);
+is_literal_pattern([]) ->
+ true.
+
compile_wildcard_3([Part|Rest], Result) ->
compile_wildcard_3(Rest, [compile_part(Part)|Result]);
compile_wildcard_3([], Result) ->
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index 7403d52881..527d083eaa 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -79,9 +79,11 @@ wildcard_one(Config) when is_list(Config) ->
do_wildcard_1(Dir,
fun(Wc) ->
L = filelib:wildcard(Wc),
+ L = filelib:wildcard(disable_prefix_opt(Wc)),
L = filelib:wildcard(Wc, erl_prim_loader),
L = filelib:wildcard(Wc, "."),
L = filelib:wildcard(Wc, Dir),
+ L = filelib:wildcard(disable_prefix_opt(Wc), Dir),
L = filelib:wildcard(Wc, Dir++"/.")
end),
file:set_cwd(OldCwd),
@@ -119,6 +121,14 @@ wcc(Wc, Error) ->
{'EXIT',{{badpattern,Error},
[{filelib,wildcard,2,_}|_]}} = (catch filelib:wildcard(Wc, ".")).
+disable_prefix_opt([C|Wc]) when $a =< C, C =< $z; C =:= $@ ->
+ %% There is an optimization for patterns that have a literal prefix
+ %% (such as "lib/compiler/ebin/*"). Test that we'll get the same result
+ %% if we disable that optimization.
+ [$[, C, $] | Wc];
+disable_prefix_opt(Wc) ->
+ Wc.
+
do_wildcard_1(Dir, Wcf0) ->
do_wildcard_2(Dir, Wcf0),
Wcf = fun(Wc0) ->
@@ -300,6 +310,30 @@ do_wildcard_10(Dir, Wcf) ->
end,
del(Files),
+ wildcard_11(Dir, Wcf).
+
+%% ERL-ERL-1029/OTP-15987: Fix problems with "@/.." and ".." in general.
+wildcard_11(Dir, Wcf) ->
+ Dirs0 = ["@","@dir","dir@"],
+ Dirs = [filename:join(Dir, D) || D <- Dirs0],
+ _ = [ok = file:make_dir(D) || D <- Dirs],
+ Files0 = ["@a","b@","x","y","z"],
+ Files = mkfiles(Files0, Dir),
+
+ ["@","@a","@dir","b@","dir@","x","y","z"] = Wcf("*"),
+ ["@"] = Wcf("@"),
+ ["@","@a","@dir"] = Wcf("@*"),
+ ["@/..","@dir/.."] = Wcf("@*/.."),
+ ["@/../@","@/../@a","@/../@dir",
+ "@dir/../@","@dir/../@a","@dir/../@dir"] = Wcf("@*/../@*"),
+
+ %% Non-directories followed by "/.." should not match any files.
+ [] = Wcf("@a/.."),
+ [] = Wcf("x/.."),
+
+ %% Cleanup.
+ del(Files),
+ [ok = file:del_dir(D) || D <- Dirs],
ok.
fold_files(Config) when is_list(Config) ->
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 1be644c620..09ef0bf7a5 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -2192,11 +2192,11 @@ revert_map_field_assoc(Node) ->
-spec map_field_assoc_name(syntaxTree()) -> syntaxTree().
map_field_assoc_name(Node) ->
- case Node of
+ case unwrap(Node) of
{map_field_assoc, _, Name, _} ->
Name;
- _ ->
- (data(Node))#map_field_assoc.name
+ Node1 ->
+ (data(Node1))#map_field_assoc.name
end.
@@ -2208,11 +2208,11 @@ map_field_assoc_name(Node) ->
-spec map_field_assoc_value(syntaxTree()) -> syntaxTree().
map_field_assoc_value(Node) ->
- case Node of
+ case unwrap(Node) of
{map_field_assoc, _, _, Value} ->
Value;
- _ ->
- (data(Node))#map_field_assoc.value
+ Node1 ->
+ (data(Node1))#map_field_assoc.value
end.
@@ -2250,11 +2250,11 @@ revert_map_field_exact(Node) ->
-spec map_field_exact_name(syntaxTree()) -> syntaxTree().
map_field_exact_name(Node) ->
- case Node of
+ case unwrap(Node) of
{map_field_exact, _, Name, _} ->
Name;
- _ ->
- (data(Node))#map_field_exact.name
+ Node1 ->
+ (data(Node1))#map_field_exact.name
end.
@@ -2266,11 +2266,11 @@ map_field_exact_name(Node) ->
-spec map_field_exact_value(syntaxTree()) -> syntaxTree().
map_field_exact_value(Node) ->
- case Node of
+ case unwrap(Node) of
{map_field_exact, _, _, Value} ->
Value;
- _ ->
- (data(Node))#map_field_exact.value
+ Node1 ->
+ (data(Node1))#map_field_exact.value
end.
@@ -5339,11 +5339,11 @@ revert_map_type_assoc(Node) ->
-spec map_type_assoc_name(syntaxTree()) -> syntaxTree().
map_type_assoc_name(Node) ->
- case Node of
+ case unwrap(Node) of
{type, _, map_field_assoc, [Name, _]} ->
Name;
- _ ->
- (data(Node))#map_type_assoc.name
+ Node1 ->
+ (data(Node1))#map_type_assoc.name
end.
@@ -5355,11 +5355,11 @@ map_type_assoc_name(Node) ->
-spec map_type_assoc_value(syntaxTree()) -> syntaxTree().
map_type_assoc_value(Node) ->
- case Node of
+ case unwrap(Node) of
{type, _, map_field_assoc, [_, Value]} ->
Value;
- _ ->
- (data(Node))#map_type_assoc.value
+ Node1 ->
+ (data(Node1))#map_type_assoc.value
end.
@@ -5397,11 +5397,11 @@ revert_map_type_exact(Node) ->
-spec map_type_exact_name(syntaxTree()) -> syntaxTree().
map_type_exact_name(Node) ->
- case Node of
+ case unwrap(Node) of
{type, _, map_field_exact, [Name, _]} ->
Name;
- _ ->
- (data(Node))#map_type_exact.name
+ Node1 ->
+ (data(Node1))#map_type_exact.name
end.
@@ -5413,11 +5413,11 @@ map_type_exact_name(Node) ->
-spec map_type_exact_value(syntaxTree()) -> syntaxTree().
map_type_exact_value(Node) ->
- case Node of
+ case unwrap(Node) of
{type, _, map_field_exact, [_, Value]} ->
Value;
- _ ->
- (data(Node))#map_type_exact.value
+ Node1 ->
+ (data(Node1))#map_type_exact.value
end.
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index e1dd1bd73b..9baf36ce11 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -24,7 +24,7 @@
%% Test cases
-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1,
- revert_map_type/1,
+ revert_map_type/1,wrapped_subtrees/1,
t_abstract_type/1,t_erl_parse_type/1,t_type/1, t_epp_dodger/1,
t_comment_scan/1,t_igor/1,t_erl_tidy/1,t_prettypr/1]).
@@ -32,6 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[app_test,appup_test,smoke_test,revert,revert_map,revert_map_type,
+ wrapped_subtrees,
t_abstract_type,t_erl_parse_type,t_type,t_epp_dodger,
t_comment_scan,t_igor,t_erl_tidy,t_prettypr].
@@ -143,6 +144,41 @@ revert_map_type(Config) when is_list(Config) ->
Form2 = erl_syntax:revert(Mapped2),
?t:timetrap_cancel(Dog).
+%% Read with erl_parse, wrap each tree node with erl_syntax and check that
+%% erl_syntax:subtrees can access the wrapped node.
+wrapped_subtrees(Config) when is_list(Config) ->
+ Dog = ?t:timetrap(?t:minutes(2)),
+ Wc = filename:join([code:lib_dir(stdlib),"src","*.erl"]),
+ Fs = filelib:wildcard(Wc) ++ test_files(Config),
+ Path = [filename:join(code:lib_dir(stdlib), "include"),
+ filename:join(code:lib_dir(kernel), "include")],
+ io:format("~p files\n", [length(Fs)]),
+ Map = fun (File) -> wrapped_subtrees_file(File, Path) end,
+ case p_run(Map, Fs) of
+ 0 -> ok;
+ N -> ?t:fail({N,errors})
+ end,
+ ?t:timetrap_cancel(Dog).
+
+wrapped_subtrees_file(File, Path) ->
+ case epp:parse_file(File, Path, []) of
+ {ok,Fs0} ->
+ lists:foreach(fun wrap_each/1, Fs0)
+ end.
+
+wrap_each(Tree) ->
+ % only `wrap` top-level erl_parse node
+ Tree1 = erl_syntax:set_pos(Tree, erl_syntax:get_pos(Tree)),
+ % assert ability to access subtrees of wrapped node with erl_syntax:subtrees/1
+ case erl_syntax:subtrees(Tree1) of
+ [] -> ok;
+ List ->
+ GrpsF = fun(Group) ->
+ lists:foreach(fun wrap_each/1, Group)
+ end,
+ lists:foreach(GrpsF, List)
+ end.
+
%% api tests
t_type(Config) when is_list(Config) ->
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl
index e4f8a1c3de..b23acdb39e 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl
@@ -37,6 +37,9 @@
-record(par, {a :: undefined | ?MODULE}).
+-record(mt, {e :: #{any() := any()},
+ a :: #{any() => any()}}).
+
-record(r0, {}).
-record(r,
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-20 12:45:06 +0000