diff options
35 files changed, 536 insertions, 341 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 903abe6f5c..76d782b159 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -531,8 +531,9 @@ TABLES= $(TARGET)/erl_bif_table.c $(TARGET)/erl_bif_table.h \ $(TARGET)/erl_atom_table.c $(TARGET)/erl_atom_table.h \ $(TARGET)/erl_pbifs.c -$(TABLES): $(ATOMS) $(BIFS) - LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET) $^ +$(TABLES): $(ATOMS) $(BIFS) utils/make_tables + LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ + $(ATOMS) $(BIFS) $(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 50f5f4fbd6..a84ee7bb23 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -135,7 +135,6 @@ do { \ (Proc)->arity = 1; \ (Proc)->def_arg_reg[0] = (Eterm) (A0); \ *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->def_arg_reg[3] = (UWord) ((Trap)->address); \ (Proc)->freason = TRAP; \ (Ret) = THE_NON_VALUE; \ } while (0) @@ -146,7 +145,6 @@ do { \ (Proc)->def_arg_reg[0] = (Eterm) (A0); \ (Proc)->def_arg_reg[1] = (Eterm) (A1); \ *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->def_arg_reg[3] = (UWord) ((Trap)->address); \ (Proc)->freason = TRAP; \ (Ret) = THE_NON_VALUE; \ } while (0) @@ -158,7 +156,6 @@ do { \ (Proc)->def_arg_reg[1] = (Eterm) (A1); \ (Proc)->def_arg_reg[2] = (Eterm) (A2); \ *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->def_arg_reg[3] = (UWord) ((Trap)->address); \ (Proc)->freason = TRAP; \ (Ret) = THE_NON_VALUE; \ } while (0) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 280421952e..ecd3c8f68a 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1499,7 +1499,7 @@ erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p) #endif #ifdef DEBUG -void p_slpq(_VOID_); +void p_slpq(void); #endif /* utils.c */ diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index ede762aae0..3376487292 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -402,7 +402,7 @@ nbif_3_simple_exception: * - the native heap/stack/reds registers are saved in P */ .handle_trap: - movq %rax, P_NARITY(P) + movl %eax, P_NARITY(P) # Note: narity is a 32-bit field movl $HIPE_MODE_SWITCH_RES_TRAP, %eax jmp .nosave_exit diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index 0651963294..c010f4f047 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -541,7 +541,7 @@ CSYM(nbif_3_simple_exception): .handle_trap: li r3, HIPE_MODE_SWITCH_RES_TRAP STORE NSP, P_NSP(P) - STORE r4, P_NARITY(P) + stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */ STORE TEMP_LR, P_NRA(P) b .nosave_exit diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index 4bb148df98..cadff12c6f 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -75,6 +75,9 @@ #ifdef HAVE_SYS_IOCTL_H # include <sys/ioctl.h> #endif +#if defined(__sun) && defined(__SVR4) +# include <stropts.h> +#endif #include "run_erl.h" #include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ @@ -864,8 +867,12 @@ static int open_pty_master(char **ptyslave) /* Use the posix_openpt if working, as this guarantees creation of the slave device properly. */ -#ifdef HAVE_WORKING_POSIX_OPENPT +#if defined(HAVE_WORKING_POSIX_OPENPT) || (defined(__sun) && defined(__SVR4)) +# ifdef HAVE_WORKING_POSIX_OPENPT if ((mfd = posix_openpt(O_RDWR)) >= 0) { +# elif defined(__sun) && defined(__SVR4) + if ((mfd = open("/dev/ptmx", O_RDWR)) >= 0) { +# endif if ((*ptyslave = ptsname(mfd)) != NULL && grantpt(mfd) == 0 && unlockpt(mfd) == 0) { @@ -981,8 +988,28 @@ static int open_pty_slave(char *name) return -1; } +#if defined(__sun) && defined(__SVR4) + /* Load the necessary STREAMS modules for Solaris */ + if ((ioctl(sfd, I_FIND, "ldterm")) < 0) { + ERROR0(LOG_ERR, "Failed to find ldterm STREAMS module"); + return -1; + } + if (ioctl(sfd, I_PUSH, "ptem") < 0) { + ERROR0(LOG_ERR, "Failed to push ptem STREAMS module"); + return -1; + } + if (ioctl(sfd, I_PUSH, "ldterm") < 0) { + ERROR0(LOG_ERR, "Failed to push ldterm STREAMS module"); + return -1; + } + if (ioctl(sfd, I_PUSH, "ttcompat") < 0) { + ERROR0(LOG_ERR, "Failed to push ttcompat STREAMS module"); + return -1; + } +#endif + #ifdef DEBUG - if (tcgetattr(sfd, &tty_rmode) , 0) { + if (tcgetattr(sfd, &tty_rmode) < 0) { fprintf(stderr, "Cannot get terminals current mode\n"); exit(-1); } diff --git a/lib/dialyzer/RELEASE_NOTES b/lib/dialyzer/RELEASE_NOTES index 62b0c92f97..a05b3ac52b 100644 --- a/lib/dialyzer/RELEASE_NOTES +++ b/lib/dialyzer/RELEASE_NOTES @@ -3,8 +3,19 @@ (in reversed chronological order) ============================================================================== -Version 2.3.0 (in Erlang/OTP R14) ---------------------------------- +Version 2.x.x (in Erlang/OTP R14B01) +------------------------------------ + - Fixed problems in the handling of remote types in records used as types + (thanks to Nico Kruber for the report and to Maria Christakis for the fix). + - Fixed handling of nested opaque types (thanks to Thorsten Schuett for + reporting it and to Maria Christakis for fixing it). + +Version 2.3.1 (in Erlang/OTP R14B) +---------------------------------- + - Eliminated warnings for auto-imported BIF clashes. + +Version 2.3.0 (in Erlang/OTP R14A) +---------------------------------- - Dialyzer properly supports the new attribute -export_type and checks that remote types only refer to exported types. A warning is produced if some files/applications refer to types defined in modules which are diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index a9da229061..248fdf6835 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -66,7 +66,7 @@ print_types1([{opaque, _Name} = Key|T], RecDict) -> io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]), print_types1(T, RecDict); print_types1([{record, _Name} = Key|T], RecDict) -> - {ok, [{Arity, Fields} = AF]} = dict:find(Key, RecDict), + {ok, [{_Arity, _Fields} = AF]} = dict:find(Key, RecDict), io:format("~w: ~w\n\n", [Key, AF]), print_types1(T, RecDict). -define(debug(D_), print_types(D_)). @@ -211,9 +211,9 @@ get_record_and_type_info([_Other|Left], Module, Records, RecDict) -> get_record_and_type_info([], _Module, Records, RecDict) -> case type_record_fields(lists:reverse(Records), RecDict) of {ok, _NewRecDict} = Ok -> - ?debug(NewRecDict), + ?debug(_NewRecDict), Ok; - {Name, {error, Error}} -> + {error, Name, Error} -> {error, lists:flatten(io_lib:format(" Error while parsing #~w{}: ~s\n", [Name, Error]))} end. @@ -269,9 +269,9 @@ type_record_fields([RecKey|Recs], RecDict) -> RecDict2 = dict:update(RecKey, Fun, RecDict1), type_record_fields(Recs, RecDict2) catch - throw:{error, _} = Error -> + throw:{error, Error} -> {record, Name} = RecKey, - {Name, Error} + {error, Name, Error} end. -spec process_record_remote_types(dialyzer_codeserver:codeserver()) -> dialyzer_codeserver:codeserver(). @@ -378,7 +378,7 @@ sets_filter([Mod|Mods], ExpTypes) -> -spec src_compiler_opts() -> [compile:option(),...]. src_compiler_opts() -> - [no_copt, to_core, binary, return_errors, + [no_copt, to_core, binary, return_errors, no_inline, strict_record_tests, strict_record_updates, no_is_record_optimization]. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 9a40be6d14..9bc56c99ff 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -3390,197 +3390,248 @@ t_from_form(Form, RecDict) -> -spec t_from_form(parse_form(), dict(), dict()) -> erl_type(). t_from_form(Form, RecDict, VarDict) -> - {T, _R} = t_from_form(Form, [], RecDict, VarDict), + {T, _R} = t_from_form(Form, [], false, RecDict, VarDict), T. -type type_names() :: [{'type' | 'opaque' | 'record', atom()}]. --spec t_from_form(parse_form(), type_names(), dict(), dict()) -> +-spec t_from_form(parse_form(), type_names(), boolean(), dict(), dict()) -> {erl_type(), type_names()}. -t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({var, _L, '_'}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) -> +t_from_form({var, _L, Name}, _TypeNames, _InOpaque, _RecDict, VarDict) -> case dict:find(Name, VarDict) of error -> {t_var(Name), []}; {ok, Val} -> {Val, []} end; -t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) -> - t_from_form(Type, TypeNames, RecDict, VarDict); -t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) -> - t_from_form(Type, TypeNames, RecDict, VarDict); +t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, InOpaque, RecDict, + VarDict) -> + t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); +t_from_form({paren_type, _L, [Type]}, TypeNames, InOpaque, RecDict, + VarDict) -> + t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), + TypeNames, InOpaque, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_remote(Module, Type, L), R}; -t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({atom, _L, Atom}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> {t_atom(Atom), []}; -t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({integer, _L, Int}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> {t_integer(Int), []}; -t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _RecDict, _VarDict) -> +t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), []}; - _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Op])}) + _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _RecDict, _VarDict) -> +t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _InOpaque, + _RecDict, _VarDict) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), []}; - _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Op])}) + _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, any, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_any(), []}; -t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, arity, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_arity(), []}; -t_from_form({type, _L, array, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, array, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_array(), []}; -t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, atom, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_atom(), []}; -t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, binary, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_binary(), []}; t_from_form({type, _L, binary, [Base, Unit]} = Type, - _TypeNames, _RecDict, _VarDict) -> + _TypeNames, _InOpaque, _RecDict, _VarDict) -> case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of {{integer, _, BaseVal}, {integer, _, UnitVal}} when BaseVal >= 0, UnitVal >= 0 -> {t_bitstr(UnitVal, BaseVal), []}; - _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Type])}) + _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, bitstring, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_bitstr(), []}; -t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, bool, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_boolean(), []}; % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, boolean, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_boolean(), []}; -t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, byte, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_byte(), []}; -t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, char, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_char(), []}; -t_from_form({type, _L, dict, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, dict, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_dict(), []}; -t_from_form({type, _L, digraph, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, digraph, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_digraph(), []}; -t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, float, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_float(), []}; -t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, function, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_fun(), []}; -t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, 'fun', []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_fun(), []}; t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, TypeNames, - RecDict, VarDict) -> - {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict), + InOpaque, RecDict, VarDict) -> + {T, R} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), {t_fun(T), R}; t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - TypeNames, RecDict, VarDict) -> - {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), - {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), + TypeNames, InOpaque, RecDict, VarDict) -> + {L, R1} = list_from_form(Domain, TypeNames, InOpaque, RecDict, VarDict), + {T, R2} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, gb_set, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, gb_set, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_gb_set(), []}; -t_from_form({type, _L, gb_tree, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, gb_tree, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_gb_tree(), []}; -t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, identifier, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_identifier(), []}; -t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, integer, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_integer(), []}; -t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, iodata, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_iodata(), []}; -t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, iolist, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_iolist(), []}; -t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, list, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_list(), []}; -t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> - {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), +t_from_form({type, _L, list, [Type]}, TypeNames, InOpaque, RecDict, + VarDict) -> + {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, mfa, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_mfa(), []}; -t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, module, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_module(), []}; -t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, nil, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_nil(), []}; -t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, neg_integer, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_neg_integer(), []}; -t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_non_neg_integer(), []}; -t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, no_return, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_unit(), []}; -t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, node, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_node(), []}; -t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, none, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_none(), []}; -t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, nonempty_list, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_nonempty_list(), []}; -t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) -> - {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), +t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, InOpaque, RecDict, + VarDict) -> + {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), {t_nonempty_list(T), R}; t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, - RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), + InOpaque, RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), {t_cons(T1, T2), R1 ++ R2}; t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, - _RecDict, _VarDict) -> + _InOpaque, _RecDict, _VarDict) -> {t_cons(?any, ?any), []}; -t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, TypeNames, - RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), +t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, + TypeNames, InOpaque, RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), {t_cons(T1, T2), R1 ++ R2}; -t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, nonempty_string, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_nonempty_string(), []}; -t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, number, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_number(), []}; -t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, pid, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_pid(), []}; -t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, port, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_port(), []}; -t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) -> - {t_pos_integer(), []}; -t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _RecDict, +t_from_form({type, _L, pos_integer, []}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> + {t_pos_integer(), []}; +t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _InOpaque, + _RecDict, _VarDict) -> {t_maybe_improper_list(), []}; -t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, TypeNames, - RecDict, VarDict) -> - {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict), +t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, + TypeNames, InOpaque, RecDict, VarDict) -> + {T1, R1} = t_from_form(Content, TypeNames, InOpaque, RecDict, VarDict), + {T2, R2} = t_from_form(Termination, TypeNames, InOpaque, RecDict, VarDict), {t_maybe_improper_list(T1, T2), R1 ++ R2}; -t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), +t_from_form({type, _L, product, Elements}, TypeNames, InOpaque, RecDict, + VarDict) -> + {L, R} = list_from_form(Elements, TypeNames, InOpaque, RecDict, VarDict), {t_product(L), R}; -t_from_form({type, _L, queue, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, queue, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_queue(), []}; t_from_form({type, _L, range, [From, To]} = Type, - _TypeNames, _RecDict, _VarDict) -> + _TypeNames, _InOpaque, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of - {{integer, _, FromVal}, - {integer, _, ToVal}} -> + {{integer, _, FromVal}, {integer, _, ToVal}} -> {t_from_range(FromVal, ToVal), []}; - _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Type])}) + _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> - record_from_form(Name, Fields, TypeNames, RecDict, VarDict); -t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, record, [Name|Fields]}, TypeNames, InOpaque, RecDict, + VarDict) -> + record_from_form(Name, Fields, TypeNames, InOpaque, RecDict, VarDict); +t_from_form({type, _L, reference, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_reference(), []}; -t_from_form({type, _L, set, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, set, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_set(), []}; -t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, string, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_string(), []}; -t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, term, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_any(), []}; -t_from_form({type, _L, tid, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, tid, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_tid(), []}; -t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, timeout, []}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_timeout(), []}; -t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> +t_from_form({type, _L, tuple, any}, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {t_tuple(), []}; -t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), +t_from_form({type, _L, tuple, Args}, TypeNames, InOpaque, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_tuple(L), R}; -t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), +t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_sup(L), R}; -t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> +t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> case lookup_type(Name, RecDict) of {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> case unfold({type, Name}, TypeNames) of @@ -3588,13 +3639,14 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> List = lists:zipwith( fun(ArgName, ArgType) -> {Ttemp, _R} = t_from_form(ArgType, TypeNames, - RecDict, VarDict), + InOpaque, RecDict, + VarDict), {ArgName, Ttemp} end, ArgNames, Args), TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{type, Name}|TypeNames], RecDict, - TmpVarDict), + {T, R} = t_from_form(Type, [{type, Name}|TypeNames], InOpaque, + RecDict, TmpVarDict), case lists:member({type, Name}, R) of true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; false -> {T, R} @@ -3607,22 +3659,28 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> true -> List = lists:zipwith( fun(ArgName, ArgType) -> - {Ttemp, _R} = t_from_form(ArgType, TypeNames, - RecDict, VarDict), + {Ttemp, _R} = t_from_form(ArgType, TypeNames, + InOpaque, RecDict, + VarDict), {ArgName, Ttemp} end, ArgNames, Args), TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], RecDict, - TmpVarDict), + {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], true, + RecDict, TmpVarDict), case lists:member({opaque, Name}, R) of true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; false -> {T, R} end; false -> {t_any(), [{opaque, Name}]} end, - Tret = t_from_form({opaque, -1, Name, {Module, Args, Rep}}, - RecDict, VarDict), + Tret = + case InOpaque of + true -> Rep; + false -> + t_from_form({opaque, -1, Name, {Module, Args, Rep}}, + RecDict, VarDict) + end, {Tret, Rret}; {type, _} -> throw({error, io_lib:format("Unknown type ~w\n", [Name])}); @@ -3631,14 +3689,15 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> error -> throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) end; -t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, - _VarDict) -> +t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, + _RecDict, _VarDict) -> case Args of [] -> {t_opaque(Mod, Name, Args, Rep), []}; _ -> throw({error, "Polymorphic opaque types not supported yet"}) end. -record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> +record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict, + VarDict) -> case unfold({record, Name}, TypeNames) of true -> case lookup_record(Name, RecDict) of @@ -3649,11 +3708,12 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> {DeclFields1, R1} = case lists:all(fun(Elem) -> Elem end, AreTyped) of true -> {DeclFields, []}; - false -> fields_from_form(DeclFields, TypeNames1, + false -> fields_from_form(DeclFields, TypeNames1, InOpaque, RecDict, dict:new()) end, {GetModRec, R2} = get_mod_record(ModFields, DeclFields1, - TypeNames1, RecDict, VarDict), + TypeNames1, InOpaque, + RecDict, VarDict), case GetModRec of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n", @@ -3670,11 +3730,13 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> false -> {t_any(), []} end. -get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) -> +get_mod_record([], DeclFields, _TypeNames, _InOpaque, _RecDict, + _VarDict) -> {{ok, DeclFields}, []}; -get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) -> +get_mod_record(ModFields, DeclFields, TypeNames, InOpaque, RecDict, + VarDict) -> DeclFieldsDict = orddict:from_list(DeclFields), - {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, + {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, InOpaque, RecDict, VarDict), case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of {error, _FieldName} = Error -> {Error, R}; @@ -3684,21 +3746,23 @@ get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) -> R} end. -build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) -> - build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []). +build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict) -> + build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict, []). build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], - TypeNames, RecDict, VarDict, Acc) -> - {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), + TypeNames, InOpaque, RecDict, VarDict, Acc) -> + {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), NewAcc = [{Name, T}|Acc], - {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc), + {D, R2} = build_field_dict(Left, TypeNames, InOpaque, RecDict, VarDict, + NewAcc), {D, R1 ++ R2}; -build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) -> +build_field_dict([], _TypeNames, _InOpaque, _RecDict, _VarDict, Acc) -> {orddict:from_list(Acc), []}. get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> - case t_is_var(ModType) orelse t_is_subtype(ModType, DeclType) of + case t_is_var(ModType) orelse t_is_remote(ModType) orelse + t_is_subtype(ModType, DeclType) of false -> {error, FieldName}; true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) end; @@ -3711,18 +3775,19 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. -fields_from_form([], _TypeNames, _RecDict, _VarDict) -> +fields_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> {[], []}; -fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, VarDict) -> - {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), - {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict), +fields_from_form([{Name, Type}|Tail], TypeNames, InOpaque, RecDict, + VarDict) -> + {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), + {F, R2} = fields_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), {[{Name, T}|F], R1 ++ R2}. -list_from_form([], _TypeNames, _RecDict, _VarDict) -> +list_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> {[], []}; -list_from_form([H|Tail], TypeNames, RecDict, VarDict) -> - {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict), - {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict), +list_from_form([H|Tail], TypeNames, InOpaque, RecDict, VarDict) -> + {T, R1} = t_from_form(H, TypeNames, InOpaque, RecDict, VarDict), + {L, R2} = list_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), {[T|L], R1 ++ R2}. -spec t_form_to_string(parse_form()) -> string(). diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 6726d62b53..3f9488d7c3 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -2,19 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%%-------------------------------------------------------------------- @@ -23,8 +23,6 @@ %%% Description : Propagate type information. %%% %%% Created : 25 Feb 2003 by Tobias Lindahl <[email protected]> -%%% -%%% $Id$ %%%-------------------------------------------------------------------- -module(hipe_icode_type). @@ -39,8 +37,6 @@ update__info/2, new__info/1, return__info/1, return_none/0, return_none_args/2, return_any_args/2]). --compile({no_auto_import,[min/2,max/2]}). - %%===================================================================== -include("../main/hipe.hrl"). @@ -80,7 +76,7 @@ %-define(server_debug, fun(X, Y) -> io:format("~p server: ~s ~p~n", [self(), X, Y]) end). -define(server_debug, fun(_, _) -> ok end). --import(erl_types, [min/2, max/2, number_min/1, number_max/1, +-import(erl_types, [number_min/1, number_max/1, t_any/0, t_atom/1, t_atom/0, t_atom_vals/1, t_binary/0, t_bitstr/0, t_bitstr_base/1, t_bitstr_unit/1, t_boolean/0, t_cons/0, t_constant/0, @@ -496,10 +492,10 @@ integer_range_less_then_propagator(IntArg1, IntArg2) -> Min2 = number_min(IntArg2), Max2 = number_max(IntArg2), %% is this the same as erl_types:t_subtract?? no ... ?? - TrueMax1 = min(Max1, erl_bif_types:infinity_add(Max2, -1)), - TrueMin2 = max(erl_bif_types:infinity_add(Min1, 1), Min2), - FalseMin1 = max(Min1, Min2), - FalseMax2 = min(Max1, Max2), + TrueMax1 = erl_types:min(Max1, erl_bif_types:infinity_add(Max2, -1)), + TrueMin2 = erl_types:max(erl_bif_types:infinity_add(Min1, 1), Min2), + FalseMin1 = erl_types:max(Min1, Min2), + FalseMax2 = erl_types:min(Max1, Max2), {t_from_range(Min1, TrueMax1), t_from_range(TrueMin2, Max2), t_from_range(FalseMin1, Max1), diff --git a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl index ac555b933c..ce33af453a 100644 --- a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl +++ b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl @@ -389,23 +389,23 @@ decrement_each([N|Ns], OldLow, IG, Vis, K) -> %% {Spilled_node, Low_degree_neighbors, New_interference_graph} spill(IG, Vis, Spill, K, SpillLimit, Target) -> - Ns = list_ig(IG), - Costs = spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target), - ?report3("spill costs are ~p~n",[Costs]), - ActualCosts = lists:sort(Costs), - ?report3("actual costs are ~p~n",[ActualCosts]), + Ns = list_ig(IG), + Costs = spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target), + ?report3("spill costs are ~p~n", [Costs]), + ActualCosts = lists:sort(Costs), + ?report3("actual costs are ~p~n", [ActualCosts]), case ActualCosts of - [] -> - ?error_msg("There is no node to spill",[]), + [] -> + ?error_msg("There is no node to spill", []), ?EXIT('no node to spill'); [{_Cost,N}|_] -> {Low, NewIG} = decrement_neighbors(N, [], IG, Vis, K), - %?report("spilled node ~p at cost ~p (~p now ready)~n",[N,Cost,Low]), + %% ?report("spilled node ~p at cost ~p (~p now ready)~n", [N,Cost,Low]), {N, Low, NewIG} end. spill_costs([], _IG, _Vis, _Spill, _SpillLimit, _Target) -> - []; + []; spill_costs([{N,Info}|Ns], IG, Vis, Spill, SpillLimit, Target) -> case degree(Info) of 0 -> spill_costs(Ns,IG,Vis,Spill, SpillLimit, Target); @@ -451,28 +451,28 @@ select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs, K) -> {Reg,NewCols} = select_color(X, IG, Cols, PhysRegs), ?report("~p~n",[Reg]), [{X,{reg,Reg}} | select_colors(Xs, IG, NewCols, PhysRegs, K)]; -%select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) -> -% ?report('spilled: ~p~n',[X]), -% %% Check if optimistic coloring could have found a color -% case catch select_color(X,IG,Cols,K) of -% {'EXIT',_} -> % no color possible -% ?report('(no optimistic color)~n',[]), -% [{X,{spill,M}}|select_colors(Xs, IG, Cols, PhysRegs, K)]; -% {Reg,NewCols} -> -% ?report('(optimistic color: ~p)~n',[Reg]), -% [{X,{reg,Reg}}|select_colors(Xs, IG, Cols, PhysRegs, K)] -% end. +%%select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) -> +%% ?report('spilled: ~p~n',[X]), +%% %% Check if optimistic coloring could have found a color +%% case catch select_color(X,IG,Cols,K) of +%% {'EXIT',_} -> % no color possible +%% ?report('(no optimistic color)~n',[]), +%% [{X,{spill,M}}|select_colors(Xs, IG, Cols, PhysRegs, K)]; +%% {Reg,NewCols} -> +%% ?report('(optimistic color: ~p)~n',[Reg]), +%% [{X,{reg,Reg}}|select_colors(Xs, IG, Cols, PhysRegs, K)] +%% end. %% Old code / pessimistic coloring: select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) -> ?report("spilled: ~p~n",[X]), %% Check if optimistic coloring could have found a color -% case catch select_color(X,IG,Cols,K) of -% {'EXIT',_} -> % no color possible -% ?report('(no optimistic color)~n',[]); -% {Reg,NewCols} -> -% ?report('(optimistic color: ~p)~n',[Reg]) -% end, +%% case catch select_color(X,IG,Cols,K) of +%% {'EXIT',_} -> % no color possible +%% ?report('(no optimistic color)~n',[]); +%% {Reg,NewCols} -> +%% ?report('(optimistic color: ~p)~n',[Reg]) +%% end, [{X,{spill,M}} | select_colors(Xs, IG, Cols, PhysRegs, K)]. select_color(X, IG, Cols, PhysRegs) -> diff --git a/lib/hipe/x86/hipe_x86_spill_restore.erl b/lib/hipe/x86/hipe_x86_spill_restore.erl index e60c446e17..cd927669fb 100644 --- a/lib/hipe/x86/hipe_x86_spill_restore.erl +++ b/lib/hipe/x86/hipe_x86_spill_restore.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% ==================================================================== @@ -71,9 +71,9 @@ firstPass(Defun) -> case hipe_x86_cfg:reverse_postorder(CFG0) of [Label1, Label2|_] -> SaveTreeElement = saveTreeLookup(Label2, SaveTree), - %% FilteredSaveTreeElement is the to be spilled temps around the function call. - %% They are spilled just before move formals - FilteredSaveTreeElement = [Temp || Temp <- SaveTreeElement, temp_is_pseudo(Temp)], + %% FilteredSaveTreeElement is the to be spilled temps around the + %% function call. They are spilled just before move formals. + FilteredSaveTreeElement = [T || T <- SaveTreeElement, temp_is_pseudo(T)], Block = hipe_x86_cfg:bb(CFG1, Label1), Code = hipe_bb:code(Block), %% The following statements are tedious but work ok. @@ -83,7 +83,7 @@ firstPass(Defun) -> %% Another solution may be to introduce another block. MoveCodes = lists:sublist(Code, length(Code)-1), JumpCode = lists:last(Code), - hipe_x86_cfg:bb_add(CFG1, Label1, hipe_bb:mk_bb(MoveCodes ++ [hipe_x86:mk_pseudo_spill(FilteredSaveTreeElement)] ++ [JumpCode])); + hipe_x86_cfg:bb_add(CFG1, Label1, hipe_bb:mk_bb(MoveCodes ++ [hipe_x86:mk_pseudo_spill(FilteredSaveTreeElement), JumpCode])); _ -> CFG1 end. @@ -110,13 +110,12 @@ firstPassHelper([Label|Labels], Liveness, CFG, SaveTree) -> NewBlock = hipe_bb:code_update(Block, NewCode), NewCFG = hipe_x86_cfg:bb_add(CFG, Label, NewBlock), SizeOfSet = setSize(NewIntersectedList), - %% if the Intersected Save List is not empty, insert it in the save tree. if SizeOfSet =/= 0 -> - UpdatedSaveTree = gb_trees:insert(Label,NewIntersectedList,SaveTree), - firstPassHelper(Labels, Liveness, NewCFG,UpdatedSaveTree); + UpdatedSaveTree = gb_trees:insert(Label, NewIntersectedList, SaveTree), + firstPassHelper(Labels, Liveness, NewCFG, UpdatedSaveTree); true -> - firstPassHelper(Labels, Liveness, NewCFG,SaveTree) + firstPassHelper(Labels, Liveness, NewCFG, SaveTree) end; firstPassHelper([], _, CFG, SaveTree) -> {CFG, SaveTree}. @@ -125,17 +124,15 @@ firstPassHelper([], _, CFG, SaveTree) -> firstPassDoBlock(Insts, LiveOut, IntersectedSaveList) -> lists:foldr(fun firstPassDoInsn/2, {LiveOut,IntersectedSaveList,[]}, Insts). -firstPassDoInsn(I, {LiveOut,IntersectedSaveList,PrevInsts} ) -> +firstPassDoInsn(I, {LiveOut,IntersectedSaveList,PrevInsts}) -> case I of #pseudo_call{} -> do_pseudo_call(I, {LiveOut,IntersectedSaveList,PrevInsts}); _ -> % other instructions DefinedList = from_list( ?HIPE_X86_LIVENESS:defines(I)), UsedList = from_list(?HIPE_X86_LIVENESS:uses(I)), - NewLiveOut = subtract(union(LiveOut, UsedList), DefinedList), - NewIntersectedSaveList = subtract(IntersectedSaveList, DefinedList), - + NewIntersectedSaveList = subtract(IntersectedSaveList, DefinedList), {NewLiveOut, NewIntersectedSaveList, [I|PrevInsts]} end. @@ -162,7 +159,7 @@ saveTreeLookup(Label, SaveTree) -> [] end. -%% Performs the second pass of the algoritm. +%% Performs the second pass of the algorithm. %% It basically eliminates the unnecessary spills and introduces restores. %% Works top down secondPass(CFG0) -> @@ -306,7 +303,8 @@ addRestoreBlockToEdge(PseudoCall, ContLabel, CFG, TempArgsList) -> NewCFG = hipe_x86_cfg:bb_add(CFG, NextLabel, NewBlock), {NewCFG, NewPseudoCall}. -%% used instead of hipe_x86_cfg:redirect_jmp since it does not handle pseudo_call calls. +%% used instead of hipe_x86_cfg:redirect_jmp since it does not handle +%% pseudo_call calls. redirect_pseudo_call(I = #pseudo_call{contlab=ContLabel}, Old, New) -> case Old =:= ContLabel of true -> I#pseudo_call{contlab=New}; @@ -323,8 +321,8 @@ temp_is_pseudo(Temp) -> %% Set operations where the module name is an easily changeable macro %%--------------------------------------------------------------------- -union(Set1,Set2) -> - ?SET_MODULE:union(Set1,Set2). +union(Set1, Set2) -> + ?SET_MODULE:union(Set1, Set2). setSize(Set) -> ?SET_MODULE:size(Set). diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index c0cf440496..ad704191a9 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -302,18 +302,25 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { -- DSA Keys and Signatures + + DSAParams ::= CHOICE + { + params Dss-Parms, + null NULL + } + -- SubjectPublicKeyInfo: dsa PUBLIC-KEY-ALGORITHM-CLASS ::= { ID id-dsa - TYPE Dss-Parms -- XXX Must be OPTIONAL + TYPE DSAParams -- XXX Must be OPTIONAL PUBLIC-KEY-TYPE DSAPublicKey } -- Certificate.signatureAlgorithm dsa-with-sha1 SIGNATURE-ALGORITHM-CLASS ::= { - ID id-dsa-with-sha1 - TYPE Dss-Parms } + ID id-dsa-with-sha1 + TYPE DSAParams } -- -- RSA Keys and Signatures diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index baa0e6c464..6e7381eb18 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> <year>2008</year> - <year>2008</year> + <year>2010</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -34,6 +34,55 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 0.9</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Updated ssl to ignore CA certs that violate the asn1-spec + for a certificate, and updated public key asn1 spec to + handle inherited DSS-params.</p> + <p> + Own Id: OTP-7884</p> + </item> + <item> + <p> + Changed ssl implementation to retain backwards + compatibility for old option {verify, 0} that shall be + equivalent to {verify, verify_none}, also separate the + cases unknown ca and selfsigned peer cert, and restored + return value of deprecated function + public_key:pem_to_der/1.</p> + <p> + Own Id: OTP-8858</p> + </item> + <item> + <p> + Better handling of v1 and v2 certificates. V1 and v2 + certificates does not have any extensions so then + validate_extensions should just accept that there are + none and not end up in missing_basic_constraints clause.</p> + <p> + Own Id: OTP-8867</p> + </item> + <item> + <p> + Changed the verify fun so that it differentiate between + the peer certificate and CA certificates by using + valid_peer or valid as the second argument to the verify + fun. It may not always be trivial or even possible to + know when the peer certificate is reached otherwise.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-8873</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 0.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index a16eb10fe6..4950597fb5 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -34,6 +34,8 @@ (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> {valid, UserState} end, []}). diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index c1819e6ddc..c467e24741 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -223,10 +223,15 @@ validate_revoked_status(_OtpCert, UserState, _VerifyFun) -> %%-------------------------------------------------------------------- validate_extensions(OtpCert, ValidationState, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, - Extensions = TBSCert#'OTPTBSCertificate'.extensions, - validate_extensions(OtpCert, Extensions, ValidationState, no_basic_constraint, - is_self_signed(OtpCert), UserState, VerifyFun). - + case TBSCert#'OTPTBSCertificate'.version of + N when N >= 3 -> + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + validate_extensions(OtpCert, Extensions, + ValidationState, no_basic_constraint, + is_self_signed(OtpCert), UserState, VerifyFun); + _ -> %% Extensions not present in versions 1 & 2 + {ValidationState, UserState} + end. %%-------------------------------------------------------------------- -spec normalize_general_name({rdnSequence, term()}) -> {rdnSequence, term()}. %% @@ -290,8 +295,8 @@ is_fixed_dh_cert(#'OTPCertificate'{tbsCertificate = %%-------------------------------------------------------------------- --spec verify_fun(#'OTPCertificate'{}, {bad_cert, atom()} | {extension, #'Extension'{}}| - valid, term(), fun()) -> term(). +-spec verify_fun(#'OTPTBSCertificate'{}, {bad_cert, atom()} | {extension, #'Extension'{}}| + valid | valid_peer, term(), fun()) -> term(). %% %% Description: Gives the user application the opportunity handle path %% validation errors and unknown extensions and optional do other @@ -389,10 +394,12 @@ public_key_info(PublicKeyInfo, NewPublicKeyParams = case PublicKeyParams of - 'NULL' when WorkingAlgorithm == Algorithm -> + {null, 'NULL'} when WorkingAlgorithm == Algorithm -> WorkingParams; - _ -> - PublicKeyParams + {params, Params} -> + Params; + Params -> + Params end, {Algorithm, PublicKey, NewPublicKeyParams}. diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src index c9d15b8747..0f9f62d2f6 100644 --- a/lib/public_key/src/public_key.appup.src +++ b/lib/public_key/src/public_key.appup.src @@ -1,62 +1,24 @@ %% -*- erlang -*- {"%VSN%", [ - {"0.7", + {"0.8", [ {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, {update, public_key, soft, soft_purge, soft_purge, []}, {update, pubkey_pem, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} - {update, pubkey_cert, soft, soft_purge, soft_purge, []} - ] - }, - {"0.6", - [ - {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, - {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_pem, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} - {update, pubkey_cert, soft, soft_purge, soft_purge, []} - ] - }, - {"0.5", - [ - {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, - {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, - {update, pubkey_pem, soft, soft_purge, soft_purge, []}, {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}, {update, pubkey_cert, soft, soft_purge, soft_purge, []} ] } ], [ - {"0.7", + {"0.8", [ {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, {update, public_key, soft, soft_purge, soft_purge, []}, {update, pubkey_pem, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} - {update, pubkey_cert, soft, soft_purge, soft_purge, []} - ] - }, - {"0.6", - [ - {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, - {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_pem, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} - {update, pubkey_cert, soft, soft_purge, soft_purge, []} - ] - }, - {"0.5", - [ - {update, 'OTP-PUB-KEY', soft, soft_purge, soft_purge, []}, - {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, - {update, pubkey_pem, soft, soft_purge, soft_purge, []}, {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}, {update, pubkey_cert, soft, soft_purge, soft_purge, []} ] - } + } ]}. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 6de5f388dc..095a6ff0e0 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -437,7 +437,7 @@ pkix_normalize_name(Issuer) -> pubkey_cert:normalize_general_name(Issuer). %%-------------------------------------------------------------------- --spec pkix_path_validation(der_encoded()| #'OTPCertificate'{} | unknown_ca, +-spec pkix_path_validation(der_encoded()| #'OTPCertificate'{} | atom(), CertChain :: [der_encoded()] , Options :: list()) -> {ok, {PublicKeyInfo :: term(), @@ -445,11 +445,11 @@ pkix_normalize_name(Issuer) -> {error, {bad_cert, Reason :: term()}}. %% Description: Performs a basic path validation according to RFC 5280. %%-------------------------------------------------------------------- -pkix_path_validation(unknown_ca, [Cert | Chain], Options0) -> +pkix_path_validation(PathErr, [Cert | Chain], Options0) when is_atom(PathErr)-> {VerifyFun, Userstat0} = proplists:get_value(verify_fun, Options0, ?DEFAULT_VERIFYFUN), Otpcert = pkix_decode_cert(Cert, otp), - Reason = {bad_cert, unknown_ca}, + Reason = {bad_cert, PathErr}, try VerifyFun(Otpcert, Reason, Userstat0) of {valid, Userstate} -> Options = proplists:delete(verify_fun, Options0), @@ -556,9 +556,16 @@ validate(DerCert, #path_validation_state{working_issuer_name = Issuer, %% We want the key_usage extension to be checked before we validate %% the signature. - UserState0 = pubkey_cert:validate_signature(OtpCert, DerCert, + UserState6 = pubkey_cert:validate_signature(OtpCert, DerCert, Key, KeyParams, UserState5, VerifyFun), - UserState = pubkey_cert:verify_fun(OtpCert, valid, UserState0, VerifyFun), + UserState = case Last of + false -> + pubkey_cert:verify_fun(OtpCert, valid, UserState6, VerifyFun); + true -> + pubkey_cert:verify_fun(OtpCert, valid_peer, + UserState6, VerifyFun) + end, + ValidationState = ValidationState1#path_validation_state{user_state = UserState}, @@ -575,7 +582,7 @@ sized_binary(List) -> %%-------------------------------------------------------------------- pem_to_der(CertSource) -> {ok, Bin} = file:read_file(CertSource), - pubkey_pem:decode(Bin). + {ok, pubkey_pem:decode(Bin)}. decode_private_key(KeyInfo) -> decode_private_key(KeyInfo, no_passwd). diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl index e31e5552d3..8b01ca3ad4 100644 --- a/lib/public_key/test/erl_make_certs.erl +++ b/lib/public_key/test/erl_make_certs.erl @@ -66,7 +66,7 @@ make_cert(Opts) -> %% @end %%-------------------------------------------------------------------- write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) -> - ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"), + ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"), [{'Certificate', Cert, not_encrypted}]), ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]). @@ -268,7 +268,7 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> subjectPublicKey = Public}; publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', - parameters=#'Dss-Parms'{p=P, q=Q, g=G}}, + parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. validity(Opts) -> @@ -290,7 +290,7 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> end, {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', #'Dss-Parms'{p=P, q=Q, g=G}}. + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. make_key(rsa, _Opts) -> %% (OBS: for testing only) diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index ea6a925139..81e01f3a02 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -379,6 +379,8 @@ pkix_path_validation(Config) when is_list(Config) -> (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> {valid, UserState} end, []}, {ok, _} = @@ -411,11 +413,11 @@ deprecated(suite) -> []; deprecated(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - [DsaKey = {'DSAPrivateKey', _DsaKey, _}] = + {ok, [DsaKey = {'DSAPrivateKey', _DsaKey, _}]} = public_key:pem_to_der(filename:join(Datadir, "dsa.pem")), - [RsaKey = {'RSAPrivateKey', _RsaKey,_}] = + {ok, [RsaKey = {'RSAPrivateKey', _RsaKey,_}]} = public_key:pem_to_der(filename:join(Datadir, "client_key.pem")), - [ProtectedRsaKey = {'RSAPrivateKey', _ProtectedRsaKey,_}] = + {ok, [ProtectedRsaKey = {'RSAPrivateKey', _ProtectedRsaKey,_}]} = public_key:pem_to_der(filename:join(Datadir, "rsa.pem")), {ok, #'DSAPrivateKey'{}} = public_key:decode_private_key(DsaKey), diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index f70209d891..2810942171 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.8 +PUBLIC_KEY_VSN = 0.9 diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 5f9e436348..756c0d1b1f 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -31,7 +31,47 @@ <p>This document describes the changes made to the SSL application. </p> - <section><title>SSL 4.0.1</title> + <section><title>SSL 4.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Updated ssl to ignore CA certs that violate the asn1-spec + for a certificate, and updated public key asn1 spec to + handle inherited DSS-params.</p> + <p> + Own Id: OTP-7884</p> + </item> + <item> + <p> + Changed ssl implementation to retain backwards + compatibility for old option {verify, 0} that shall be + equivalent to {verify, verify_none}, also separate the + cases unknown ca and selfsigned peer cert, and restored + return value of deprecated function + public_key:pem_to_der/1.</p> + <p> + Own Id: OTP-8858</p> + </item> + <item> + <p> + Changed the verify fun so that it differentiate between + the peer certificate and CA certificates by using + valid_peer or valid as the second argument to the verify + fun. It may not always be trivial or even possible to + know when the peer certificate is reached otherwise.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-8873</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 4.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index d5b7253ef3..413703deca 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -202,10 +202,10 @@ <p>The verification fun should be defined as:</p> <code> -fun(OtpCert :: #'OtpCertificate'{}, Event :: {bad_cert, Reason :: atom()} | +fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | {extension, #'Extension'{}}, InitialUserState :: term()) -> - {valid, UserState :: term()} | {fail, Reason :: term()} | - {unknown, UserState :: term()}. + {valid, UserState :: term()} | {valid_peer, UserState :: term()} | + {fail, Reason :: term()} | {unknown, UserState :: term()}. </code> <p>The verify fun will be called during the X509-path @@ -213,10 +213,12 @@ fun(OtpCert :: #'OtpCertificate'{}, Event :: {bad_cert, Reason :: atom()} | application is encountered. Additionally it will be called when a certificate is considered valid by the path validation to allow access to each certificate in the path to the user - application. + application. Note that the it will differentiate between + the peer certificate and CA certificates by using valid_peer + or valid as the second argument to the verify fun. See <seealso marker="public_key:application">public_key(3)</seealso> - for definition of #'OtpCertificate'{} and #'Extension'{}.</p> + for definition of #'OTPCertificate'{} and #'Extension'{}.</p> <p>If the verify callback fun returns {fail, Reason}, the verification process is immediately stopped and an alert is @@ -237,21 +239,23 @@ fun(OtpCert :: #'OtpCertificate'{}, Event :: {bad_cert, Reason :: atom()} | (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> - {valid, UserState} + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} end, []} </code> <p>The default verify_fun option in verify_none mode:</p> <code> -{fun(_,{bad_cert, unknown_ca}, UserState) -> +{fun(_,{bad_cert, _}, UserState) -> {valid, UserState}; - (_,{bad_cert, _} = Reason, _) -> - {fail, Reason}; (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> - {valid, UserState} + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} end, []} </code> @@ -267,13 +271,14 @@ fun(OtpCert :: #'OtpCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> - <p>Option described here are client specific or has a slightly different + <p>Options described here are client specific or has a slightly different meaning in the client than in the server.</p> <taglist> <tag>{verify, verify_type()}</tag> - <item> In verify_none mode the x509-path validation error {bad_cert, unknown_ca} - will automatically be accepted. See also the verify_fun option. + <item> In verify_none mode the default behavior will be to + allow all x509-path validation errors. See also the verify_fun + option. </item> <tag>{reuse_sessions, boolean()}</tag> <item>Specifies if client should try to reuse sessions @@ -286,7 +291,7 @@ fun(OtpCert :: #'OtpCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <section> <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title> - <p>Option described here are server specific or has a slightly different + <p>Options described here are server specific or has a slightly different meaning in the server than in the client.</p> <taglist> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 88cd73be74..f4e6b59b6d 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,32 +1,9 @@ %% -*- erlang -*- {"%VSN%", [ - {"4.0", [{restart_application, ssl}]}, - {"3.11.1", [{restart_application, ssl}]}, - {"3.11", [{restart_application, ssl}]}, - {"3.10", [{restart_application, ssl}]}, - {"3.10.1", [{restart_application, ssl}]}, - {"3.10.2", [{restart_application, ssl}]}, - {"3.10.3", [{restart_application, ssl}]}, - {"3.10.4", [{restart_application, ssl}]}, - {"3.10.5", [{restart_application, ssl}]}, - {"3.10.6", [{restart_application, ssl}]}, - {"3.10.7", [{restart_application, ssl}]}, - {"3.10.8", [{restart_application, ssl}]}, - {"3.10.9", [{restart_application, ssl}]} + {"4.0.1", [{restart_application, ssl}]} ], [ - {"4.0", [{restart_application, ssl}]}, - {"3.11.1", [{restart_application, ssl}]}, - {"3.11", [{restart_application, ssl}]}, - {"3.10", [{restart_application, ssl}]}, - {"3.10.1", [{restart_application, ssl}]}, - {"3.10.2", [{restart_application, ssl}]}, - {"3.10.3", [{restart_application, ssl}]}, - {"3.10.4", [{restart_application, ssl}]}, - {"3.10.5", [{restart_application, ssl}]}, - {"3.10.6", [{restart_application, ssl}]}, - {"3.10.8", [{restart_application, ssl}]}, - {"3.10.9", [{restart_application, ssl}]} + {"4.0.1", [{restart_application, ssl}]} ]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 314bdd1aab..ef94750d02 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -621,17 +621,19 @@ handle_options(Opts0, _Role) -> ReuseSessionFun = fun(_, _, _, _) -> true end, - VerifyNoneFun = - {fun(_,{bad_cert, unknown_ca}, UserState) -> + DefaultVerifyNoneFun = + {fun(_,{bad_cert, _}, UserState) -> {valid, UserState}; - (_,{bad_cert, _} = Reason, _) -> - {fail, Reason}; (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> {valid, UserState} end, []}, + VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), + UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), UserVerifyFun = handle_option(verify_fun, Opts, undefined), CaCerts = handle_option(cacerts, Opts, undefined), @@ -727,6 +729,8 @@ validate_option(verify_fun, Fun) when is_function(Fun) -> (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> {valid, UserState} end, Fun}; validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) -> diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index d2ab21657c..5571fb01f6 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -57,30 +57,32 @@ trusted_cert_and_path(CertChain, CertDbRef) -> Path = [Cert | _] = lists:reverse(CertChain), OtpCert = public_key:pkix_decode_cert(Cert, otp), - IssuerID = + SignedAndIssuerID = case public_key:pkix_is_self_signed(OtpCert) of true -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), - IssuerId; + {self, IssuerId}; false -> case public_key:pkix_issuer_id(OtpCert, other) of {ok, IssuerId} -> - IssuerId; + {other, IssuerId}; {error, issuer_not_found} -> case find_issuer(OtpCert, no_candidate) of {ok, IssuerId} -> - IssuerId; + {other, IssuerId}; Other -> Other end end end, - case IssuerID of + case SignedAndIssuerID of {error, issuer_not_found} -> %% The root CA was not sent and can not be found. {unknown_ca, Path}; - {SerialNr, Issuer} -> + {self, _} when length(Path) == 1 -> + {selfsigned_peer, Path}; + {_ ,{SerialNr, Issuer}} -> case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of {ok, {BinCert,_}} -> {BinCert, Path}; @@ -130,6 +132,8 @@ validate_extension(_, {bad_cert, _} = Reason, _) -> validate_extension(_, {extension, _}, Role) -> {unknown, Role}; validate_extension(_, valid, Role) -> + {valid, Role}; +validate_extension(_, valid_peer, Role) -> {valid, Role}. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 86477f369d..2a5a7f3394 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -216,9 +216,15 @@ add_certs_from_file(File, Ref, CertsDb) -> [Add(Cert) || {'Certificate', Cert, not_encrypted} <- PemEntries]. add_certs(Cert, Ref, CertsDb) -> - ErlCert = public_key:pkix_decode_cert(Cert, otp), - TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, - SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, - Issuer = public_key:pkix_normalize_name( - TBSCertificate#'OTPTBSCertificate'.issuer), - insert({Ref, SerialNumber, Issuer}, {Cert,ErlCert}, CertsDb). + try ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.issuer), + insert({Ref, SerialNumber, Issuer}, {Cert,ErlCert}, CertsDb) + catch + error:_ -> + Report = io_lib:format("SSL WARNING: Ignoring a CA cert as " + "it could not be correctly decoded.~n", []), + error_logger:info_report(Report) + end. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 3f01be101c..5b1a510034 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -578,6 +578,8 @@ path_validation_alert({bad_cert, unknown_critical_extension}) -> ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); path_validation_alert({bad_cert, cert_revoked}) -> ?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED); +path_validation_alert({bad_cert, selfsigned_peer}) -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); path_validation_alert({bad_cert, unknown_ca}) -> ?ALERT_REC(?FATAL, ?UNKNOWN_CA); path_validation_alert(_) -> diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index f8aef55754..8b01ca3ad4 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -268,7 +268,7 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> subjectPublicKey = Public}; publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', - parameters=#'Dss-Parms'{p=P, q=Q, g=G}}, + parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. validity(Opts) -> @@ -290,7 +290,7 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> end, {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', #'Dss-Parms'{p=P, q=Q, g=G}}. + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. make_key(rsa, _Opts) -> %% (OBS: for testing only) diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 3cb9337775..fade67f3ba 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -2857,11 +2857,13 @@ unknown_server_ca_fail(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - FunAndState = {fun(_,{bad_cert, _} = Reason, _) -> + FunAndState = {fun(_,{bad_cert, unknown_ca} = Reason, _) -> {fail, Reason}; (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, [test_to_update_user_state | UserState]}; + (_, valid_peer, UserState) -> {valid, UserState} end, []}, @@ -2930,6 +2932,8 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> (_,{extension, _}, UserState) -> {unknown, UserState}; (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> {valid, UserState} end, []}, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 709a089892..30a0a3b3f7 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1,2 @@ -SSL_VSN = 4.0.1 + +SSL_VSN = 4.1 diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 6b0f2034f8..9f6f7d815e 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -809,6 +809,8 @@ tokens_to_string([{atom,_,A} | Ts]) -> io_lib:write_atom(A) ++ " " ++ tokens_to_string(Ts); tokens_to_string([{string, _, S} | Ts]) -> io_lib:write_string(S) ++ " " ++ tokens_to_string(Ts); +tokens_to_string([{char, _, C} | Ts]) -> + io_lib:write_char(C) ++ " " ++ tokens_to_string(Ts); tokens_to_string([{float, _, F} | Ts]) -> float_to_list(F) ++ " " ++ tokens_to_string(Ts); tokens_to_string([{integer, _, N} | Ts]) -> diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index bbbb7883db..2ddffccf5b 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -226,9 +226,11 @@ to_upper(String) -> String). word_size() -> - case erlang:system_info(wordsize) of - 4 -> ""; - 8 -> "/64" + case {erlang:system_info({wordsize,external}), + erlang:system_info({wordsize,internal})} of + {4,4} -> ""; + {8,8} -> "/64"; + {8,4} -> "/Halfword" end. linux_dist() -> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 91acfdf2b6..ed825a298f 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1481,7 +1481,23 @@ Other commands: erlang-font-lock-keywords-3 erlang-font-lock-keywords-4) nil nil ((?_ . "w")) erlang-beginning-of-clause - (font-lock-mark-block-function . erlang-mark-clause)))) + (font-lock-mark-block-function . erlang-mark-clause) + (font-lock-syntactic-keywords + ;; A dollar sign right before the double quote that ends a + ;; string is not a character escape. + ;; + ;; And a "string" has with a double quote not escaped by a + ;; dollar sign, any number of non-backslash non-newline + ;; characters or escaped backslashes, a dollar sign + ;; (otherwise we wouldn't care) and a double quote. This + ;; doesn't match multi-line strings, but this is probably + ;; the best we can get, since while font-locking we don't + ;; know whether matching started inside a string: limiting + ;; search to a single line keeps things sane. + . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w") + ;; And the dollar sign in $\" escapes two characters, not + ;; just one. + ("\\(\\$\\)\\\\\\\"" 1 "'")))))) diff --git a/make/emd2exml.in b/make/emd2exml.in index 17cb0a0b57..ea1085cf71 100644 --- a/make/emd2exml.in +++ b/make/emd2exml.in @@ -44,6 +44,7 @@ -define(DELAYED_TOC_IX, 1). -define(DELAYED_START_IX, 2). +-compile({no_auto_import,[error/2]}). -mode(compile). -export([main/1]). |