Skip to content

R
riscv-gcc-1
Commit a267d8cc by Arnaud Charlet
Options

[multiple changes] 

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb, sem_ch13.adb, sem_ch6.adb: Minor reformatting.

2017-04-25  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Resolve_Actuals): Under -gnatd.q, reset
	Is_True_Constant for an array variable that is passed to a
	foreign function as an 'in' parameter.
	* debug.adb: Document -gnatd.q.

From-SVN: r247218
parent 241f328c
Showing with 52 additions and 24 deletions
gcc/ada/ChangeLog
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb, sem_ch13.adb, sem_ch6.adb: Minor reformatting.
2017-04-25 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Actuals): Under -gnatd.q, reset
Is_True_Constant for an array variable that is passed to a
foreign function as an 'in' parameter.
* debug.adb: Document -gnatd.q.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): If expression function
......
gcc/ada/debug.adb
......@@ -107,7 +107,7 @@ package body Debug is
-- d.n Print source file names
-- d.o Conservative elaboration order for indirect calls
-- d.p Use original Ada 95 semantics for Bit_Order (disable AI95-0133)
-- d.q
-- d.q Suppress optimizations on imported 'in'
-- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s
-- d.t Disable static allocation of library level dispatch tables
......@@ -562,6 +562,13 @@ package body Debug is
-- interpretation of component clauses crossing byte boundaries when
-- using the non-default bit order (i.e. ignore AI95-0133).
-- d.q If an array variable or constant is not modified in Ada code, and
-- is passed to an 'in' parameter of a foreign-convention subprogram,
-- and that subprogram modifies the array, the Ada compiler normally
-- assumes that the array is not modified. This option suppresses such
-- optimizations. This option should not be used; the correct solution
-- is to declare the parameter 'in out'.
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants.
......@@ -826,8 +833,8 @@ package body Debug is
-- prefer specs with no bodies to specs with bodies, and between two
-- specs with bodies, prefers the one whose body is closer to being
-- able to be elaborated. This is a clear improvement, but we provide
-- this debug flag in case of regressions. Note: -do is even older than
-- -dp.
-- this debug flag in case of regressions. Note: -gnatdo is even older
-- than -gnatdp.
-- dp Use old elaboration order preference. The new preference rules
-- elaborate all units within a strongly connected component together,
......
gcc/ada/exp_ch6.adb
......@@ -409,13 +409,13 @@ package body Exp_Ch6 is
Desig_Typ := Directly_Designated_Type (Ptr_Typ);
-- Check for a library-level access type whose designated type has
-- supressed finalization. Such an access types lack a master.
-- Pass a null actual to the callee in order to signal a missing
-- master.
-- suppressed finalization or the access type is subject to pragma
-- No_Heap_Finalization. Such an access type lacks a master. Pass
-- a null actual to callee in order to signal a missing master.
if Is_Library_Level_Entity (Ptr_Typ)
and then (Finalize_Storage_Only (Desig_Typ)
or else No_Heap_Finalization (Ptr_Typ))
or else No_Heap_Finalization (Ptr_Typ))
then
Actual := Make_Null (Loc);
......
gcc/ada/sem_ch13.adb
......@@ -4371,18 +4371,13 @@ package body Sem_Ch13 is
-- Note that analysis will have added the interpretation
-- that corresponds to the dereference. We only check the
-- subprogram itself.
-- subprogram itself. Ignore homonyms that may come from
-- derived types in the context.
if Is_Overloadable (It.Nam) then
-- Ignore homonyms that may come from derived types
-- in the context.
if not Comes_From_Source (It.Nam) then
null;
else
Check_One_Function (It.Nam);
end if;
if Is_Overloadable (It.Nam)
and then Comes_From_Source (It.Nam)
then
Check_One_Function (It.Nam);
end if;
Get_Next_Interp (I, It);
......@@ -4392,8 +4387,8 @@ package body Sem_Ch13 is
if not Indexing_Found and then not Error_Posted (N) then
Error_Msg_NE
("aspect Indexing requires a local function that "
& "applies to type&", Expr, Ent);
("aspect Indexing requires a local function that applies to "
& "type&", Expr, Ent);
end if;
end Check_Indexing_Functions;
......
gcc/ada/sem_ch6.adb
......@@ -3091,15 +3091,15 @@ package body Sem_Ch6 is
-- Check that the enclosing record type can be frozen.
-- This provides a better error message than generating
-- primitives whose compilation fails much later.
-- Refine the error message if possible.
-- primitives whose compilation fails much later. Refine
-- the error message if possible.
Check_Fully_Declared (Rec, Node);
if Error_Posted (Node) then
if Has_Private_Component (Rec) then
Error_Msg_NE ("\type& has private component",
Node, Rec);
Error_Msg_NE
("\type& has private component", Node, Rec);
end if;
else
......
gcc/ada/sem_res.adb
......@@ -4211,6 +4211,21 @@ package body Sem_Res is
end if;
end if;
-- In -gnatd.q mode, forget that a given array is constant when
-- it is passed as an IN parameter to a foreign-convention
-- subprogram. This is in case the subprogram evilly modifies the
-- object. Of course, correct code would use IN OUT.
if Debug_Flag_Dot_Q
and then Ekind (F) = E_In_Parameter
and then Has_Foreign_Convention (Nam)
and then Is_Array_Type (F_Typ)
and then Nkind (A) in N_Has_Entity
and then Present (Entity (A))
then
Set_Is_True_Constant (Entity (A), False);
end if;
-- Case of OUT or IN OUT parameter
if Ekind (F) /= E_In_Parameter then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment