Skip to content

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

[multiple changes] 

2016-06-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib-xref-spark_specific.adb, checks.adb, sem_ch13.adb: Minor
	reformatting.
	* exp_ch7.adb: Minor typo fix.
	* lib.ads (Get_Top_Level_Code_Unit): Add comment.

2016-06-22  Bob Duff  <duff@adacore.com>

	* s-tassta.adb (Task_Wrapper): Fix handling of Fall_Back_Handler
	wrt independent tasks.

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_dim.adb (Analyze_Dimension): Propagate dimension for
	explicit_dereference nodes when they do not come from source,
	to handle correctly dimensional analysis on iterators over
	containers whose elements have declared dimensions.

From-SVN: r237691
parent 7ffbef99
Showing with 61 additions and 26 deletions
gcc/ada/ChangeLog
2016-06-22 Hristian Kirtchev <kirtchev@adacore.com>
* lib-xref-spark_specific.adb, checks.adb, sem_ch13.adb: Minor
reformatting.
* exp_ch7.adb: Minor typo fix.
* lib.ads (Get_Top_Level_Code_Unit): Add comment.
2016-06-22 Bob Duff <duff@adacore.com>
* s-tassta.adb (Task_Wrapper): Fix handling of Fall_Back_Handler
wrt independent tasks.
2016-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_dim.adb (Analyze_Dimension): Propagate dimension for
explicit_dereference nodes when they do not come from source,
to handle correctly dimensional analysis on iterators over
containers whose elements have declared dimensions.
2016-06-22 Arnaud Charlet <charlet@adacore.com>
* spark_xrefs.ads (Scope_Num): type refined to positive integers.
......
gcc/ada/checks.adb
......@@ -635,17 +635,15 @@ package body Checks is
procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id) is
pragma Assert (Nkind (N) = N_Freeze_Entity);
AC : constant Node_Id := Address_Clause (E);
Loc : constant Source_Ptr := Sloc (AC);
Typ : constant Entity_Id := Etype (E);
AC : constant Node_Id := Address_Clause (E);
Loc : constant Source_Ptr := Sloc (AC);
Typ : constant Entity_Id := Etype (E);
Expr : Node_Id;
-- Address expression (not necessarily the same as Aexp, for example
-- when Aexp is a reference to a constant, in which case Expr gets
-- reset to reference the value expression of the constant).
-- Start of processing for Apply_Address_Clause_Check
begin
-- See if alignment check needed. Note that we never need a check if the
-- maximum alignment is one, since the check will always succeed.
......@@ -679,8 +677,8 @@ package body Checks is
AL : Uint := Alignment (Typ);
begin
-- The object alignment might be more restrictive than the
-- type alignment.
-- The object alignment might be more restrictive than the type
-- alignment.
if Known_Alignment (E) then
AL := Alignment (E);
......@@ -718,9 +716,9 @@ package body Checks is
-- Generate a check to raise PE if alignment may be inappropriate
else
-- If the original expression is a non-static constant, use the
-- name of the constant itself rather than duplicating its
-- defining expression, which was extracted above.
-- If the original expression is a non-static constant, use the name
-- of the constant itself rather than duplicating its initialization
-- expression, which was extracted above.
-- Note: Expr is empty if the address-clause is applied to in-mode
-- actuals (allowed by 13.1(22)).
......@@ -729,8 +727,8 @@ package body Checks is
or else
(Is_Entity_Name (Expression (AC))
and then Ekind (Entity (Expression (AC))) = E_Constant
and then Nkind (Parent (Entity (Expression (AC))))
= N_Object_Declaration)
and then Nkind (Parent (Entity (Expression (AC)))) =
N_Object_Declaration)
then
Expr := New_Copy_Tree (Expression (AC));
else
......@@ -745,9 +743,9 @@ package body Checks is
Make_Raise_Program_Error (Loc,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd =>
Left_Opnd =>
Make_Op_Mod (Loc,
Left_Opnd =>
Left_Opnd =>
Unchecked_Convert_To
(RTE (RE_Integer_Address), Expr),
Right_Opnd =>
......@@ -755,7 +753,7 @@ package body Checks is
Prefix => New_Occurrence_Of (E, Loc),
Attribute_Name => Name_Alignment)),
Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
Reason => PE_Misaligned_Address_Value));
Reason => PE_Misaligned_Address_Value));
Warning_Msg := No_Error_Msg;
Analyze (First (Actions (N)), Suppress => All_Checks);
......@@ -765,6 +763,7 @@ package body Checks is
-- No_Exception_Propagation).
if Warning_Msg /= No_Error_Msg then
-- If the expression has a known at compile time value, then
-- once we know the alignment of the type, we can check if the
-- exception will be raised or not, and if not, we don't need
......@@ -773,12 +772,13 @@ package body Checks is
if Compile_Time_Known_Value (Expr) then
Alignment_Warnings.Append
((E => E, A => Expr_Value (Expr), W => Warning_Msg));
else
-- Add explanation of the warning generated by the check
-- Add explanation of the warning generated by the check
else
Error_Msg_N
("\address value may be incompatible with alignment "
& "of object?X?", AC);
("\address value may be incompatible with alignment of "
& "object?X?", AC);
end if;
end if;
......@@ -786,6 +786,7 @@ package body Checks is
end if;
exception
-- If we have some missing run time component in configurable run time
-- mode then just skip the check (it is not required in any case).
......
gcc/ada/exp_ch7.adb
......@@ -4616,7 +4616,7 @@ package body Exp_Ch7 is
Set_Ghost_Mode_From_Entity (Work_Typ);
-- Emulate the environment of the invariant procedure by installing
-- its scope and formal parameters. Note that this is not need, but
-- its scope and formal parameters. Note that this is not needed, but
-- having the scope of the invariant procedure installed helps with
-- the detection of invariant-related errors.
......
gcc/ada/lib.ads
......@@ -548,6 +548,12 @@ package Lib is
-- This is like Get_Code_Unit, except that in the case of subunits, it
-- returns the top-level unit to which the subunit belongs instead of
-- the subunit.
--
-- Note: for nodes and slocs in declarations of library-level instances of
-- generics these routines wrongly return the unit number corresponding to
-- the body of the instance. In effect, locations of SPARK references in
-- ALI files are bogus. However, fixing this is not worth the effort, since
-- these references are only used for debugging.
function In_Extended_Main_Code_Unit
(N : Node_Or_Entity_Id) return Boolean;
......
gcc/ada/s-tassta.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1339,7 +1339,13 @@ package body System.Tasking.Stages is
if Self_ID.Common.Specific_Handler /= null then
TH := Self_ID.Common.Specific_Handler;
else
-- Independent tasks should not call the Fall_Back_Handler (of the
-- environment task), because they are implementation artifacts that
-- should be invisible to Ada programs.
elsif Self_ID.Master_of_Task /= Independent_Task_Level then
-- Look for a fall-back handler following the master relationship
-- for the task. As specified in ARM C.7.3 par. 9/2, "the fall-back
-- handler applies only to the dependent tasks of the task". Hence,
......
gcc/ada/sem_ch13.adb
......@@ -13204,11 +13204,11 @@ package body Sem_Ch13 is
-- Get alignments, sizes and offset, if any
X_Alignment := Alignment (ACCR.X);
X_Size := Esize (ACCR.X);
X_Size := Esize (ACCR.X);
if Present (ACCR.Y) then
Y_Alignment := Alignment (ACCR.Y);
Y_Size := Esize (ACCR.Y);
Y_Size := Esize (ACCR.Y);
end if;
if ACCR.Off
......
gcc/ada/sem_dim.adb
......@@ -1121,13 +1121,15 @@ package body Sem_Dim is
begin
-- Aspect is an Ada 2012 feature. Note that there is no need to check
-- dimensions for nodes that don't come from source, except for subtype
-- declarations where the dimensions are inherited from the base type.
-- declarations where the dimensions are inherited from the base type,
-- and for explicit dereferences generated when expanding iterators.
if Ada_Version < Ada_2012 then
return;
elsif not Comes_From_Source (N)
and then Nkind (N) /= N_Subtype_Declaration
and then Nkind (N) /= N_Explicit_Dereference
then
return;
end if;
......@@ -2015,7 +2017,8 @@ package body Sem_Dim is
end if;
end if;
-- Removal of dimensions in expression
-- Remove dimensions from inner expressions, to prevent dimensions
-- table from growing uselessly.
case Nkind (N) is
when N_Attribute_Reference |
......
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