* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@247218
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
-- 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
-- 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.
-- 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,
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);
-- 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);
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;
-- 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
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
projects / thirdparty / gcc.git / commitdiff
