2019-09-19  Raphael Amiard  <amiard@adacore.com>

gcc/ada/

	* libgnat/a-cbhama.ads, libgnat/a-cbhase.ads,
	libgnat/a-chtgop.ads (Clear): Refine comments

From-SVN: r275936

This fixes a spurious type mismatch failure reported between formal and
actual of a call to a subprogram that comes from the instantiation of a
child generic unit that itself contains an instantiation of a slibling
child generic unit, when the parent is itself a generic unit with
private part. The regression was introduced by a recent change made to
clear the Is_Generic_Actual_Type on the implicit full view built when a
generic package is instantiated on a private type.

2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_ch12.adb (Restore_Private_Views): Comment out new code
	that clear the Is_Generic_Actual_Type also on the full view.

gcc/testsuite/

	* gnat.dg/generic_inst13.adb,
	gnat.dg/generic_inst13_pkg-nested_g.ads,
	gnat.dg/generic_inst13_pkg-ops_g.ads,
	gnat.dg/generic_inst13_pkg.ads: New testcase.

From-SVN: r275935

This patch fixes a bug where an array object initialized with a
concatenation, and that has an aspect_specification for Alignment,
causes the compiler goes into an infinite loop.

2019-09-19  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch3.adb (Rewrite_As_Renaming): Return False if there are
	any aspect specifications, because otherwise Insert_Actions
	blows up.

gcc/testsuite/

	* gnat.dg/concat3.adb: New testcase.

From-SVN: r275934

This fixes a regression introduced by the previous change that improved
the handling of explicit by-reference mechanism. For the very specific
case of a component of a bit-packed array, the front-end still needs to
insert a copy around the call because this is where the rewriting into
the sequence of mask-and-shifts is done for the code generator.

2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Add
	Bit_Packed_Array parameter and documet it. Always insert a copy
	if it is set True.
	(Expand_Actuals): Adjust the calls to
	Add_Simple_Call_By_Copy_Code.

gcc/testsuite/

	* gnat.dg/pack26.adb: New testcase.

From-SVN: r275933

This patch fixes a bug in which if a symbol is not found, gnatxref can
sometimes enter an infinite loop. No impact on compilation.

2019-09-19  Bob Duff  <duff@adacore.com>

gcc/ada/

	* xref_lib.adb (Get_Symbol_Name): If we reach EOF in the first
	loop without finding the symbol, return "???". Otherwise, it's
	an infinite loop.
	(Parse_EOL): Assert that we're not already at EOF.  Remove
	processing of LF/CR -- there are no operating systems that use
	that.

From-SVN: r275932

This improves the handling of an explicit by-reference passing mechanism
specified by means of the GNAT pragma Export_Function.  This device sort
of circumvents the rules of the language for the by-reference passing
mechanism and it's then up to the programmer to ensure that the actual
parameter is addressable; if it is not, the compiler will generate a
temporary around the call, thus effectively passing the actual by copy.

It turns out that the compiler was too conservative when determining
whether the actual parameter is addressable, in particular if it's a
component of a record type subject to a representation clause.

The change effectively moves this computation from the front-end to the
back-end, which has much more information on the layout and alignment
of types and thus can be less conservative.

2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch6.adb (Is_Legal_Copy): Also return false for an aliased
	formal and a formal passed by reference in convention Ada.  Add
	missing guard to the existing test on Is_Valued_Procedure.

From-SVN: r275931

2019-09-19  Bob Duff  <duff@adacore.com>

gcc/ada/

	* rtsfind.ads (RTE_Available): Improve comment.

From-SVN: r275930

2019-09-19  Richard Biener  <rguenther@suse.de>

	* tree-parloops.c (parloops_is_slp_reduction): Do not set
	LOOP_VINFO_OPERANDS_SWAPPED.
	(parloops_is_simple_reduction): Likewise.
	* tree-vect-loop.c (_loop_vec_info::_loop_vec_info): Do not
	initialize operands_swapped.
	(_loop_vec_info::~_loop_vec_info): Do not re-canonicalize stmts.
	(vect_is_slp_reduction): Do not swap operands.
	* tree-vectorizer.h (_loop_vec_info::operands_swapped): Remove.
	(LOOP_VINFO_OPERANDS_SWAPPED): Likewise.

From-SVN: r275928

Extend pass rpad to handle avx512f vcvtusi2ss vcvtusi2ss
538.imagick_r improved by 4% with single copy run on SKYLAKE workstation.

gcc/
	* config/i386/i386.md
	(*floatuns<SWI48:mode><MODEF:mode>2_avx512):
	Add avx_partial_xmm_update.

gcc/testsuie
	* gcc.target/i386/pr87007-3.c: New test.

From-SVN: r275926

	PR target/91683
	* config/riscv/riscv-protos.h (riscv_split_symbol): New bool parameter.
	(riscv_move_integer): Likewise.
	* config/riscv/riscv.c (riscv_split_integer): Pass FALSE for new
	riscv_move_integer arg.
	(riscv_legitimize_move): Likewise.
	(riscv_force_temporary): New parameter in_splitter.  Don't call
	force_reg if true.
	(riscv_unspec_offset_high): Pass FALSE for new riscv_force_temporary
	arg.
	(riscv_add_offset): Likewise.
	(riscv_split_symbol): New parameter in_splitter.  Pass to
	riscv_force_temporary.
	(riscv_legitimize_address): Pass FALSE for new riscv_split_symbol
	arg.
	(riscv_move_integer): New parameter in_splitter.  New local
	can_create_psuedo.  Don't call riscv_split_integer or force_reg when
	in_splitter TRUE.
	(riscv_legitimize_const_move): Pass FALSE for new riscv_move_integer,
	riscv_split_symbol, and riscv_force_temporary args.
	* config/riscv/riscv.md (low<mode>+1): Pass TRUE for new
	riscv_move_integer arg.
	(low<mode>+2): Pass TRUE for new riscv_split_symbol arg.

From-SVN: r275925

From-SVN: r275924

    
    This CL serves as part of an initial change for enabling gollvm
    building on arm64 linux, the rest of the change will be covered by
    another one to the gollvm repo.
    
    Incorporate type definition of 'uint128' to 'runtime' and 'syscall'
    packges, the change is not specific to arm64 linux but made available
    for all platforms.
    
    Verified by building and unit-testing gollvm on linux x86-64 and arm64.
    
    Verified by building and checking gccgo on linux x86-64 and arm64.
    
    Fixes golang/go#33711
    
    Change-Id: I4720c7d810cfd4ef720962fb4104c5641b2459c0

From-SVN: r275919

We currently use default mid-end expanders for logical DImode operations.
These split operations without first splitting off complex immediates or
memory operands.  The resulting expansions are non-optimal and allow for
fewer LDRD/STRD opportunities.  So add back explicit expanders which ensure
memory operands and immediates are handled more efficiently.

    gcc/
	PR target/91738
	* config/arm/arm.md (<logical_op>di3): Expand explicitly.
	(one_cmpldi2): Likewise.
	* config/arm/arm.c (const_ok_for_dimode_op): Return true if one
	of the constant parts is simple.
	* config/arm/iterators.md (LOGICAL): Add new code iterator.
	(logical_op): Add new code attribute.
	(logical_OP): Likewise.
	* config/arm/predicates.md (arm_anddi_operand): Add predicate.
	(arm_iordi_operand): Add predicate.
	(arm_xordi_operand): Add predicate.

From-SVN: r275907

On Skylake, we should move integer register to SSE register without
going through memory.  This patch restores Skylake SImode hard register
store cost to 6.

gcc/

	PR target/90878
	* config/i386/x86-tune-costs.h (skylake_cost): Restore SImode
	hard register store cost to 6.

gcc/testsuite/

	PR target/90878
	* gcc.target/i386/pr90878.c: New test.

From-SVN: r275906

On Skylake, SImode store cost isn't less than half cost of 128-bit vector
store.  This patch increases Skylake SImode pseudo register store cost to
make it the same as QImode and HImode.

gcc/

	PR target/91446
	* config/i386/x86-tune-costs.h (skylake_cost): Increase SImode
	pseudo register store cost from 3 to 6 to make it the same as
	QImode and HImode.

gcc/testsuite/

	PR target/91446
	* gcc.target/i386/pr91446.c: New test.

From-SVN: r275905

Cleanup 64-bit multiplies.  Combine the expanders using iterators.
Merge the signed/unsigned multiplies as well as the pre-Armv6 and Armv6
variants.  Split DImode operands early into parallel sets inside the
MULL/MLAL instructions - this improves register allocation and avoids
subreg issues due to other DImode operations splitting early.

    gcc/
	* config/arm/arm.md (maddsidi4): Remove expander.
	(mulsidi3adddi): Remove pattern.
	(mulsidi3adddi_v6): Likewise.
	(mulsidi3_nov6): Likewise.
	(mulsidi3_v6): Likewise.
	(umulsidi3): Remove expander.
	(umulsidi3_nov6): Remove pattern.
	(umulsidi3_v6): Likewise.
	(umulsidi3adddi): Likewise.
	(umulsidi3adddi_v6): Likewise.
	(<Us>mulsidi3): Add combined expander.
	(<Us>maddsidi4): Likewise.
	(<US>mull): Add combined umull and smull pattern.
	(<US>mlal): Likewise.
	* config/arm/iterators.md (Us): Add new iterator.

From-SVN: r275901

Cleanup the various highpart multiply patterns using iterators.
As a result the signed and unsigned variants and the pre-Armv6
multiply operand constraints are all handled in a single pattern
and simple expander.

    gcc/
	* config/arm/arm.md (smulsi3_highpart): Use <US> and <SE> iterators.
	(smulsi3_highpart_nov6): Remove pattern.
	(smulsi3_highpart_v6): Likewise.
	(umulsi3_highpart): Likewise.
	(umulsi3_highpart_nov6): Likewise.
	(umulsi3_highpart_v6): Likewise.
	(<US>mull_high): Add new combined multiply pattern.

From-SVN: r275899

2019-09-18  Richard Biener  <rguenther@suse.de>

	* tree-vect-loop.c (vect_is_simple_reduction): Remove operand
	swapping.
	(vectorize_fold_left_reduction): Remove assert.
	(vectorizable_reduction): Also expect COND_EXPR non-reduction
	operand in position 2.  Remove assert.

From-SVN: r275898

Cleanup the 32-bit multiply patterns.  Merge the pre-Armv6 with the Armv6
patterns, remove useless alternatives and order the accumulator operands
to prefer MLA Ra, Rb, Rc, Ra whenever feasible.

    gcc/
	* config/arm/arm.md (arm_mulsi3): Remove pattern.
	(arm_mulsi3_v6): Likewise.
	(mulsi3addsi_v6): Likewise.
	(mulsi3subsi): Likewise.
	(mul): Add new multiply pattern.
	(mla): Likewise.
	(mls): Likewise.

From-SVN: r275897

2019-09-18  Richard Biener  <rguenther@suse.de>

	* tree-parloops.c (report_ploop_op): Copy from report_vect_op.
	(parloops_valid_reduction_input_p): Copy from
	valid_reduction_input_p.
	(parloops_is_slp_reduction): Copy from vect_is_slp_reduction.
	(parloops_needs_fold_left_reduction_p): Copy from
	needs_fold_left_reduction_p.
	(parloops_is_simple_reduction): Copy from
	vect_is_simple_reduction.
	(parloops_force_simple_reduction): Copy from
	vect_force_simple_reduction.
	(gather_scalar_reductions): Adjust.
	* tree-vect-loop.c (vect_force_simple_reduction): Make static.
	* tree-vectorizer.h (vect_force_simple_reduction): Remove.

From-SVN: r275896

2019-09-18  Martin Liska  <mliska@suse.cz>

	* clang-format: Tweak configuration based on new
	options offered.

From-SVN: r275875

2019-09-18  Richard Biener  <rguenther@suse.de>

	* tree-vectorizer.h (get_initial_def_for_reduction): Remove.
	* tree-vect-loop.c (get_initial_def_for_reduction): Make
	static.
	(vect_create_epilog_for_reduction): Remove dead code.

From-SVN: r275874

assemble_real used GEN_INT to create integers directly from the
longs returned by real_to_target.  assemble_integer then went on
to interpret the const_ints as though they had the mode corresponding
to the accompanying size parameter:

      imode = mode_for_size (size * BITS_PER_UNIT, mclass, 0).require ();

      for (i = 0; i < size; i += subsize)
	{
	  rtx partial = simplify_subreg (omode, x, imode, i);

But in the assemble_real case, X might not be canonical for IMODE.

If the interface to assemble_integer is supposed to allow outputting
(say) the low 4 bytes of a DImode integer, then the simplify_subreg
above is wrong.  But if the number of bytes passed to assemble_integer
is supposed to be the number of bytes that the integer actually contains,
assemble_real is wrong.

This patch takes the latter interpretation and makes assemble_real
generate const_ints that are canonical for the number of bytes passed.

The flip_storage_order handling assumes that each long is a full
SImode, which e.g. excludes BITS_PER_UNIT != 8 and float formats
whose memory size is not a multiple of 32 bits (which includes
HFmode at least).  The patch therefore leaves that code alone.
If interpreting each integer as SImode is correct, the const_ints
that it generates are also correct.

2019-09-18  Richard Sandiford  <richard.sandiford@arm.com>

gcc/
	* varasm.c (assemble_real): Generate canonical const_ints.

From-SVN: r275873

2019-09-18  Richard Biener  <rguenther@suse.de>

	PR lto/91763
	* lto-streamer-in.c (input_eh_regions): Move EH init to
	lto_materialize_function.
	* tree-streamer-in.c (lto_input_ts_function_decl_tree_pointers):
	Likewise.

	lto/
	* lto.c (lto_materialize_function): Initialize EH by looking
	at the function personality and flag_exceptions setting.

From-SVN: r275872

CONSTANT lattice values are symbolic constants rather than
compile-time constants, so among other things can be POLY_INT_CSTs.
This patch fixes a case in which we assumed all CONSTANTs were either
ADDR_EXPRs or INTEGER_CSTs.

This is tested by later SVE patches.

2019-09-18  Richard Sandiford  <richard.sandiford@arm.com>

gcc/
	* tree-ssa-ccp.c (get_value_for_expr): Check whether CONSTANTs
	are INTEGER_CSTs.

From-SVN: r275871

Source-level SVE vectors should be gimplified in the same way
as normal fixed-length vectors rather than as VLAs.

This is tested by later SVE patches.

2019-09-18  Richard Sandiford  <richard.sandiford@arm.com>

gcc/
	* gimplify.c (gimplify_decl_expr): Use poly_int_tree_p instead
	of checking specifically for INTEGER_CST.

From-SVN: r275870

This patch makes compute_record_mode handle SVE vectors in the
same way as it would handle fixed-length vectors.  There should
be no change in behaviour for other targets.

This is needed for the SVE equivalent of arm_neon.h types like
int8x8x2_t (i.e. a pair of int8x8_ts).

2019-09-18  Richard Sandiford  <richard.sandiford@arm.com>

gcc/
	* stor-layout.c (compute_record_mode): Operate on poly_uint64
	sizes instead of uhwi sizes.

From-SVN: r275869

loc_list_for_tree_1 and add_const_value_attribute currently ICE
on POLY_INTs.  loc_list_for_tree_1 can do something sensible but
add_const_value_attribute has to punt, since the constant there
needs to be a link-time rather than load-time or run-time constant.

This is tested by later SVE patches.

2019-09-18  Richard Sandiford  <richard.sandiford@arm.com>

gcc/
	* dwarf2out.c (loc_list_from_tree_1): Handle POLY_INT_CST.
	(add_const_value_attribute): Handle CONST_POLY_INT.

From-SVN: r275868

2019-09-18  Martin Liska  <mliska@suse.cz>

	* dbgcnt.def (store_merging): New counter.
	* gimple-ssa-store-merging.c (imm_store_chain_info::output_merged_stores):
	Use it in store merging.

From-SVN: r275867

The recent Copy_Bitfield change caused gnatbind to change elaboration
order, causing different error messages.

2019-09-18  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield): Move call
	to RTE_Available later, so it doesn't disturb the elab order.
	The RE_Copy_Bitfield entity is defined in package
	System.Bitfields which has a dependency on package
	System.Bitfield_Utils, which has it its spec:

	   pragma Elaborate_Body;

	The query on RTE_Available forces loading and analyzing
	System.Bitfields and all its withed units.

From-SVN: r275866

This eliminates a spurious alignment warning given by the compiler on an
address clause when the No_Exception_Propagation restriction is in
effect and the -gnatw.x switch is used. In this configuration the
address clauses whose expression is itself of the form X'Address would
not be sufficiently analyzed and, therefore, the compiler might give
false positive warnings.

2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.ads (Alignment_Warnings_Record): Add P component.
	* checks.adb (Apply_Address_Clause_Check): Be prepared to kill
	the warning also if the clause is of the form X'Address.
	(Validate_Alignment_Check_Warning): Kill the warning if the
	clause is of the form X'Address and the alignment of X is
	compatible.

gcc/testsuite/

	* gnat.dg/warn31.adb, gnat.dg/warn31.ads: New testcase.

From-SVN: r275865

This patch fixes a compiler abort on a case expression whose
alternatives are universal_real constants, when the case expression is
an operand in a multiplication or division whose other operand is of a
fixed-point type.

2019-09-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_res.adb (Set_Mixed_Node_Expression): If a conditional
	expression has universal_real alternaitves and the context is
	Universal_Fixed, as when it is an operand in a fixed-point
	multiplication or division, resolve the expression with a
	visible fixed-point type, which must be unique.

gcc/testsuite/

	* gnat.dg/fixedpnt8.adb: New testcase.

From-SVN: r275864

This patch allows the construction of a static subtype for the generated
constrained Secondary_Stack component of a task for which a stack size
is specified, when compiling for a restricted run-time that forbids
dynamic allocation. Needed for LLVM.

2019-09-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Constrain_Component_Type): For a discriminated
	type, handle the case of a constraint given by a conversion of a
	discriminant of the enclosing type. Necessary when compiling a
	discriminated task for a restricted run-time, when the generated
	Secondary_Stack component may be set by means of an aspect on
	the task type.

From-SVN: r275863

This patch fixes a crash on a an aggregate for a discriminated type,
when a component of the aggregate is also a discriminated type
constrained by a discriminant of the enclosing object, and the default
value for the component is a conditional expression that includes
references to that outer discriminant.

2019-09-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_aggr.adb (Expand_Record_Aggregate, Rewrite_Discriminant):
	After rewriting a reference to an outer discriminant as a
	selected component of the enclosing object, analyze the selected
	component to ensure that the entity of the selector name is
	properly set. This is necessary when the aggregate appears
	within an expression that may have been analyzed already.

gcc/testsuite/

	* gnat.dg/discr58.adb: New testcase.

From-SVN: r275862

This patch fixes an issue whereby expansion of post conditions may lead
to spurious ineffective use_clause warnings when a use type clause is
present in a package specification and a use package clause exists in
the package body on the package containing said type.

2019-09-18  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* sem_ch8.adb (Use_One_Type): Add guard to prevent warning on a
	reundant use package clause where there is no previous
	use_clause in the chain.

gcc/testsuite/

	* gnat.dg/warn30.adb, gnat.dg/warn30.ads: New testcase.

From-SVN: r275861

This patch fixes an issue whereby assignments from anonymous access
descriminants which are part of stand alone objects of anonymous access
did not have runtime checks generated based on the accessibility level
of the object according to ARM 3.10.2 (12.5/3).

2019-09-18  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Type_Conversion): Add calculation of an
	alternative operand for the purposes of generating accessibility
	checks.

gcc/testsuite/

	* gnat.dg/access8.adb, gnat.dg/access8_pkg.adb,
	gnat.dg/access8_pkg.ads: New testcase.

From-SVN: r275860

This change fixes a long-standing issue in the compiler that is
generally silent but may lead to wrong code generation in specific
circumstances.  When an others choice in an array aggregate spans
multiple ranges, the compiler may generate multiple (groups of)
assignments for the ranges.

The problem is that it internally reuses the original expression for all
the ranges, which is problematic if this expression gets rewritten
during the processing of one of the ranges and typically causes a new
temporary to be shared between different ranges.

The solution is to duplicate the original expression for each range.

2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Build_Array_Aggr_Code): In STEP 1 (c), duplicate
	the expression and reset the Loop_Actions for each loop
	generated for an others choice.

gcc/testsuite/

	* gnat.dg/aggr28.adb: New testcase.

From-SVN: r275859

This patch fixes an issue whereby subprograms with anonymous access
formals may trigger spurious runtime accessibility errors when such
formals are used as actuals in calls to nested subprograms.

Running these commands:

  gnatmake -q pass.adb
  gnatmake -q fail.adb
  gnatmake -q test_main.adb
  gnatmake -q indirect_call_test.adb
  pass
  fail
  test_main
  indirect_call_test

On the following sources:

--  pass.adb

procedure Pass is

  function A (Param : access Integer) return Boolean is
    type Typ is access all Integer;
    function A_Inner (Param : access Integer) return Typ is
      begin
        return Typ (Param); --  OK
      end;
    begin
      return A_Inner (Param) = Typ (Param);
    end;

  function B (Param : access Integer) return Boolean;
  function B (Param : access Integer) return Boolean is
    type Typ is access all Integer;
    function B_Inner (Param : access Integer) return Typ is
      begin
        return Typ (Param); --  OK
      end;
    begin
      return B_Inner (Param) = Typ (Param);
    end;

  procedure C (Param : access Integer) is
    type Typ is access all Integer;
    Var : Typ;
    procedure C_Inner (Param : access Integer) is
      begin
        Var := Typ (Param); --  OK
      end;
    begin
      C_Inner (Param);
    end;

  procedure D (Param : access Integer);
  procedure D (Param : access Integer) is
    type Typ is access all Integer;
    Var : Typ;
    procedure D_Inner (Param : access Integer) is
      begin
        Var := Typ (Param); --  OK
      end;
    begin
      D_Inner (Param);
    end;

  protected type E is
    function G (Param : access Integer) return Boolean;
    procedure I (Param : access Integer);
  end;

  protected body E is
    function F (Param : access Integer) return Boolean is
      type Typ is access all Integer;
      function F_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  OK
        end;
      begin
        return F_Inner (Param) = Typ (Param);
      end;

    function G (Param : access Integer) return Boolean is
      type Typ is access all Integer;
      function G_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  OK
        end;
      B : Boolean := F (Param); --  OK
      begin
        return G_Inner (Param) = Typ (Param);
      end;

    procedure H (Param : access Integer) is
      type Typ is access all Integer;
      Var : Typ;
      procedure H_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  OK
        end;
      begin
        H_Inner (Param);
      end;

    procedure I (Param : access Integer) is
      type Typ is access all Integer;
      Var : Typ;
      procedure I_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  OK
        end;
      begin
        H (Param); --  OK
        I_Inner (Param);
      end;
  end;

  task type J is end;

  task body J is
    function K (Param : access Integer) return Boolean is
      type Typ is access all Integer;
      function K_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  OK
        end;
      begin
        return K_Inner (Param) = Typ (Param);
      end;

    function L (Param : access Integer) return Boolean;
    function L (Param : access Integer) return Boolean is
      type Typ is access all Integer;
      function L_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  OK
        end;
      begin
        return L_Inner (Param) = Typ (Param);
      end;

    procedure M (Param : access Integer) is
      type Typ is access all Integer;
      Var : Typ;
      procedure M_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  OK
        end;
      begin
        M_Inner (Param);
      end;

    procedure N (Param : access Integer);
    procedure N (Param : access Integer) is
      type Typ is access all Integer;
      Var : Typ;
      procedure N_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  OK
        end;
      begin
        N_Inner (Param);
      end;
    Var : aliased Integer := 666;
    begin
      if K (Var'Access) then null; end if; --  OK
      if L (Var'Access) then null; end if; --  OK
      M (Var'Access);                      --  OK
      N (Var'Access);                      --  OK
    end;

begin
  begin
    begin
      declare
      Var  : aliased Integer := 666;
      T    : J;
      Prot : E;
      begin
        if A (Var'Access) then null; end if;      --  OK
        if B (Var'Access) then null; end if;      --  OK
        C (Var'Access);                           --  OK
        D (Var'Access);                           --  OK
        if Prot.G (Var'Access) then null; end if; --  OK
        Prot.I (Var'Access);                      --  OK
      end;
    end;
  end;
end;

--  fail.adb

procedure Fail is
  Failures : Integer := 0;

  type Base_Typ is access all Integer;

  function A (Param : access Integer) return Boolean is
    subtype Typ is Base_Typ;
    function A_Inner (Param : access Integer) return Typ is
      begin
        return Typ (Param); --  ERROR
      end;
    begin
      return A_Inner (Param) = Typ (Param);
    exception
      when others => Failures := Failures + 1;
      return False;
    end;

  function B (Param : access Integer) return Boolean;
  function B (Param : access Integer) return Boolean is
    subtype Typ is Base_Typ;
    function B_Inner (Param : access Integer) return Typ is
      begin
        return Typ (Param); --  ERROR
      end;
    begin
      return B_Inner (Param) = Typ (Param);
    exception
      when others => Failures := Failures + 1;
      return False;
    end;

  procedure C (Param : access Integer) is
    subtype Typ is Base_Typ;
    Var : Typ;
    procedure C_Inner (Param : access Integer) is
      begin
        Var := Typ (Param); --  ERROR
      end;
    begin
      C_Inner (Param);
    exception
      when others => Failures := Failures + 1;
    end;

  procedure D (Param : access Integer);
  procedure D (Param : access Integer) is
    subtype Typ is Base_Typ;
    Var : Typ;
    procedure D_Inner (Param : access Integer) is
      begin
        Var := Typ (Param); --  ERROR
      end;
    begin
      D_Inner (Param);
    exception
      when others => Failures := Failures + 1;
    end;

  protected type E is
    function G (Param : access Integer) return Boolean;
    procedure I (Param : access Integer);
  end;

  protected body E is
    function F (Param : access Integer) return Boolean is
      subtype Typ is Base_Typ;
      function F_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  ERROR
        end;
      begin
        return F_Inner (Param) = Typ (Param);
      exception
        when others => Failures := Failures + 1;
        return False;
      end;

    function G (Param : access Integer) return Boolean is
      subtype Typ is Base_Typ;
      function G_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  ERROR
        end;
      B : Boolean := F (Param); --  ERROR
      begin
        return G_Inner (Param) = Typ (Param);
      exception
        when others => Failures := Failures + 1;
        return False;
      end;

    procedure H (Param : access Integer) is
      subtype Typ is Base_Typ;
      Var : Typ;
      procedure H_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  ERROR
        end;
      begin
        H_Inner (Param);
      exception
        when others => Failures := Failures + 1;
      end;

    procedure I (Param : access Integer) is
      subtype Typ is Base_Typ;
      Var : Typ;
      procedure I_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  ERROR
        end;
      begin
        H (Param); --  ERROR
        I_Inner (Param);
      exception
        when others => Failures := Failures + 1;
      end;
  end;

  task type J is end;

  task body J is
    function K (Param : access Integer) return Boolean is
      subtype Typ is Base_Typ;
      function K_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  ERROR
        end;
      begin
        return K_Inner (Param) = Typ (Param);
      exception
        when others => Failures := Failures + 1;
        return False;
      end;

    function L (Param : access Integer) return Boolean;
    function L (Param : access Integer) return Boolean is
      subtype Typ is Base_Typ;
      function L_Inner (Param : access Integer) return Typ is
        begin
          return Typ (Param); --  ERROR
        end;
      begin
        return L_Inner (Param) = Typ (Param);
      exception
        when others => Failures := Failures + 1;
        return False;
      end;

    procedure M (Param : access Integer) is
      subtype Typ is Base_Typ;
      Var : Typ;
      procedure M_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  ERROR
        end;
      begin
        M_Inner (Param);
      exception
        when others => Failures := Failures + 1;
      end;

    procedure N (Param : access Integer);
    procedure N (Param : access Integer) is
      subtype Typ is Base_Typ;
      Var : Typ;
      procedure N_Inner (Param : access Integer) is
        begin
          Var := Typ (Param); --  ERROR
        end;
      begin
        N_Inner (Param);
      exception
        when others => Failures := Failures + 1;
      end;
    Var : aliased Integer := 666;
    begin
      if K (Var'Access) then null; end if; --  ERROR
      if L (Var'Access) then null; end if; --  ERROR
      M (Var'Access);                      --  ERROR
      N (Var'Access);                      --  ERROR
    end;

begin
  begin
    begin
      declare
      Var  : aliased Integer := 666;
      T    : J;
      Prot : E;
      begin
        if A (Var'Access) then null; end if;      --  ERROR
        if B (Var'Access) then null; end if;      --  ERROR
        C (Var'Access);                           --  ERROR
        D (Var'Access);                           --  ERROR
        if Prot.G (Var'Access) then null; end if; --  ERROR
        Prot.I (Var'Access);                      --  ERROR
        if Failures /= 12 then
          raise Program_Error;
        end if;
      end;
    end;
  end;
end;

--  indirect_call_test.adb

with Text_IO;

procedure Indirect_Call_Test is

   Tracing_Enabled : constant Boolean := False;
   procedure Trace (S : String) is
   begin
      if Tracing_Enabled then
        Text_IO.Put_Line (S);
      end if;
   end;

   package Pkg is
      type Root is abstract tagged null record;
      function F (X : Root; Param : access Integer)
        return Boolean is abstract;
   end Pkg;

   function F_Wrapper
     (X : Pkg.Root; Param : access Integer)
     return Boolean
     is (Pkg.F (Pkg.Root'Class (X), Param));
     -- dispatching call

   function A (Param : access Integer) return Boolean is
      type Typ is access all Integer;

      package Nested is
         type Ext is new Pkg.Root with null record;
         overriding function F
           (X : Ext; Param : access Integer)
           return Boolean;
      end Nested;

      function A_Inner
        (Param : access Integer) return Typ is
      begin
         return Typ (Param);  -- OK
      end A_Inner;

      package body Nested is
         function F (X : Ext; Param : access Integer)
          return Boolean is
         begin
            return A_Inner (Param) = null;
         end;
      end;

       Ext_Obj : Nested.Ext;
   begin
       Trace ("In subtest A");
       return F_Wrapper (Pkg.Root (Ext_Obj), Param);
   exception
      when Program_Error =>
          Trace ("Failed");
          return True;
   end A;

   function B (Param : access Integer) return Boolean is
      type Typ is access all Integer;

      function B_Inner
        (Param : access Integer) return Typ is
      begin
         return Typ (Param); -- OK
      end B_Inner;

      type Ref is access function
         (Param : access Integer) return Typ;
      Ptr : Ref := B_Inner'Access;

      function Ptr_Caller return Typ is
        (Ptr.all (Param)); -- access-to-subp value
   begin
      Trace ("In subtest B");
      return Ptr_Caller = null;
   exception
      when Program_Error =>
          Trace ("*** failed");
          return True;
   end B;

begin
   begin
      begin
         declare
            Var : aliased Integer := 666;
         begin
            if A (Var'Access) then
               null;
            end if;
            Trace ("Subtest A done");
            if B (Var'Access) then
               null;
            end if;
            Trace ("Subtest B done");
         end;
      end;
   end;
end Indirect_Call_Test;

Should produce the following output:

  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure
  Failure

2019-09-18  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* einfo.adb, einfo.ads (Minimum_Accessibility): Added new field.
	(Set_Minimum_Accessibility): Added to set new field.
	(Minimum_Accessibility): Added to fetch new field.
	* exp_ch6.adb (Expand_Subprogram_Call): Modify calls to fetch
	accessibility levels to the new subprogram Get_Accessibility
	which handles cases where minimum accessibility might be needed.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Add section to
	generate a Minimum_Accessibility object within relevant
	subprograms.
	* sem_util.adb, sem_util.ads (Dynamic_Accessibility_Level):
	Additional documentation added and modify section to use new
	function Get_Accessibility.
	(Get_Accessibility): Added to centralize processing of
	accessibility levels.

From-SVN: r275858

In Ada2012, a discriminant value that governs an active variant part in
an aggregate had to be static. AI12-0086 relaxes this restriction - if
the subtype of the discriminant value is a static subtype all of whose
values select the same variant, then that is good enough.

2019-09-18  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_util.ads (Interval_Lists): A new visible package. This
	package is visible because it is also intended for eventual use
	in Sem_Eval.Subtypes_Statically_Compatible when that function is
	someday upgraded to handle static predicates correctly.  This
	new package doesn't really need to be visible for now, but it
	still seems like a good idea.
	* sem_util.adb (Gather_Components): Implement AI12-0086 via the
	following strategy. The existing code knows how to take a static
	discriminant value and identify the corresponding variant; in
	the newly-permitted case of a non-static value of a static
	subtype, we arbitrarily select a value of the subtype and find
	the corresponding variant using the existing code. Subsequently,
	we check that every other value of the discriminant's subtype
	corresponds to the same variant; this is done using the newly
	introduced Interval_Lists package.
	(Interval_Lists): Provide a body for the new package.

gcc/testsuite/

	* gnat.dg/ai12_0086_example.adb: New testcase.

From-SVN: r275857

This patch improves the portability of the code generated by the
compiler for access to subprograms. Written by Richard Kenner.

2019-09-18  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Op_Eq): The frontend assumes that we can
	do a bit-for-bit comparison of two access to protected
	subprogram pointers. However, there are two reasons why we may
	not be able to do that: (1) there may be padding bits for
	alignment before the access to subprogram, and (2) the access to
	subprogram itself may not be compared bit-for- bit because the
	activation record part is undefined: two pointers are equal iff
	the subprogram addresses are equal. This patch fixes it by
	forcing a field-by-field comparison.
	* bindgen.adb (Gen_Adainit): The type No_Param_Proc is defined
	in the library as having Favor_Top_Level, but when we create an
	object of that type in the binder file we don't have that
	pragma, so the types are different. This patch fixes this issue.
	* libgnarl/s-interr.adb, libgnarl/s-interr__hwint.adb,
	libgnarl/s-interr__sigaction.adb, libgnarl/s-interr__vxworks.adb
	(Is_Registered): This routine erroneously assumes that the
	access to protected subprogram is two addresses. We need to
	create the same record that the compiler makes to ensure that
	any padding is the same. Then we have to look at just the first
	word of the access to subprogram. This patch fixes this issue.

From-SVN: r275856