[multiple changes]
2016-11-30 Gary Dismukes <dismukes@adacore.com> * sem_prag.adb, sem_ch6.adb: Minor reformatting and typo fixes. * g-sechas.adb: Minor reformatting. * lib-xref.ads: minor grammar fix in comment. * lib-xref-spark_specific.adb (Is_SPARK_Reference): do not ignore references to concurrent objects. * sinfo.ads: Fix of unbalanced parens in comment 2016-11-30 Ed Schonberg <schonberg@adacore.com> * lib-xref.adb (Get_Type_Reference): If the entity is a function returning a classwide type, the type reference is obtained right away and does not need further unwinding. 2016-11-30 Javier Miranda <miranda@adacore.com> * sem_ch8.adb (Find_Renamed_Entity): For non-overloaded subprogram actuals of generic units check that the spec of the renaming and renamed entities match. 2016-11-30 Tristan Gingold <gingold@adacore.com> * raise-gcc.c: For CERT runtimes: do not use gcc includes, simplify the handling. * sem_attr.adb (Analyze_Attribute): Check No_Dynamic_Priorities restriction for Priority Attribute. From-SVN: r243022
This commit is contained in:
Arnaud Charlet
parent
ba85c8c3fc
commit
60aa522875
|
|
@ -1,3 +1,32 @@
|
|||
2016-11-30 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* sem_prag.adb, sem_ch6.adb: Minor reformatting and typo fixes.
|
||||
* g-sechas.adb: Minor reformatting.
|
||||
* lib-xref.ads: minor grammar fix in comment.
|
||||
* lib-xref-spark_specific.adb
|
||||
(Is_SPARK_Reference): do not ignore references to concurrent
|
||||
objects.
|
||||
* sinfo.ads: Fix of unbalanced parens in comment
|
||||
|
||||
2016-11-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* lib-xref.adb (Get_Type_Reference): If the entity is a function
|
||||
returning a classwide type, the type reference is obtained right
|
||||
away and does not need further unwinding.
|
||||
|
||||
2016-11-30 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch8.adb (Find_Renamed_Entity): For non-overloaded subprogram
|
||||
actuals of generic units check that the spec of the renaming
|
||||
and renamed entities match.
|
||||
|
||||
2016-11-30 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* raise-gcc.c: For CERT runtimes: do not use gcc includes, simplify
|
||||
the handling.
|
||||
* sem_attr.adb (Analyze_Attribute): Check No_Dynamic_Priorities
|
||||
restriction for Priority Attribute.
|
||||
|
||||
2016-11-27 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
PR ada/78524
|
||||
|
|
|
|||
|
|
@ -253,7 +253,7 @@ package body GNAT.Secure_Hashes is
|
|||
if Index = First_Index then
|
||||
|
||||
-- Message_Length is in bytes, but we need to store it as
|
||||
-- a bit count).
|
||||
-- a bit count.
|
||||
|
||||
Pad (Index) := Character'Val
|
||||
(Shift_Left (Message_Length and 16#1f#, 3));
|
||||
|
|
|
|||
|
|
@ -527,13 +527,6 @@ package body SPARK_Specific is
|
|||
if Ekind (E) in Overloadable_Kind then
|
||||
return Typ = 's';
|
||||
|
||||
-- Objects of task or protected types are not SPARK references
|
||||
|
||||
elsif Present (Etype (E))
|
||||
and then Ekind (Etype (E)) in Concurrent_Kind
|
||||
then
|
||||
return False;
|
||||
|
||||
-- In all other cases, result is true for reference/modify cases,
|
||||
-- and false for all other cases.
|
||||
|
||||
|
|
|
|||
|
|
@ -1508,6 +1508,14 @@ package body Lib.Xref is
|
|||
Entity (Original_Node (Object_Definition (Decl)));
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- For a function that returns a class-wide type, Tref is
|
||||
-- already correct.
|
||||
|
||||
elsif Is_Overloadable (Ent)
|
||||
and then Is_Class_Wide_Type (Tref)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- For anything else, exit
|
||||
|
|
|
|||
|
|
@ -691,7 +691,7 @@ package Lib.Xref is
|
|||
-- the spec. The entity in the body is treated as a reference with type
|
||||
-- 'b'. Similar handling for references to subprogram formals.
|
||||
--
|
||||
-- The call has no effect if N is not in the extended main source unit
|
||||
-- The call has no effect if N is not in the extended main source unit.
|
||||
-- This check is omitted for type 'e' references (where it is useful to
|
||||
-- have structural scoping information for other than the main source),
|
||||
-- and for 'p' (since we want to pick up inherited primitive operations
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 1992-2014, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2016, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT 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- *
|
||||
|
|
@ -36,8 +36,13 @@
|
|||
#error "RTS unit only"
|
||||
#endif
|
||||
|
||||
#ifndef CERT
|
||||
#include "tconfig.h"
|
||||
#include "tsystem.h"
|
||||
#else
|
||||
#define ATTRIBUTE_UNUSED __attribute__((unused))
|
||||
#define HAVE_GETIPINFO 1
|
||||
#endif
|
||||
|
||||
#include <stdarg.h>
|
||||
typedef char bool;
|
||||
|
|
@ -80,6 +85,15 @@ extern struct Exception_Occurrence *__gnat_setup_current_excep
|
|||
(_Unwind_Exception *);
|
||||
extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
|
||||
|
||||
#ifdef CERT
|
||||
#define abort() __gnat_raise_abort()
|
||||
static void __gnat_raise_abort(void)
|
||||
{
|
||||
while (1)
|
||||
;
|
||||
}
|
||||
#endif
|
||||
|
||||
#include "unwind-pe.h"
|
||||
|
||||
/* The known and handled exception classes. */
|
||||
|
|
@ -928,9 +942,13 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception)
|
|||
/* All others and others choice match any foreign exception. */
|
||||
if (choice == GNAT_ALL_OTHERS
|
||||
|| choice == GNAT_OTHERS
|
||||
|| choice == (_Unwind_Ptr) &Foreign_Exception)
|
||||
#ifndef CERT
|
||||
|| choice == (_Unwind_Ptr) &Foreign_Exception
|
||||
#endif
|
||||
)
|
||||
return handler;
|
||||
|
||||
#ifndef CERT
|
||||
/* C++ exception occurrences. */
|
||||
if (exception_class_eq (propagated_exception, CXX_EXCEPTION_CLASS)
|
||||
&& Language_For (choice) == 'C')
|
||||
|
|
@ -947,6 +965,7 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception)
|
|||
if (choice_typeinfo == except_typeinfo)
|
||||
return handler;
|
||||
}
|
||||
#endif
|
||||
|
||||
return nothing;
|
||||
}
|
||||
|
|
@ -1172,6 +1191,7 @@ personality_body (_Unwind_Action uw_phases,
|
|||
}
|
||||
else
|
||||
{
|
||||
#ifndef CERT
|
||||
struct Exception_Occurrence *excep;
|
||||
|
||||
/* Trigger the appropriate notification routines before the second
|
||||
|
|
@ -1182,6 +1202,7 @@ personality_body (_Unwind_Action uw_phases,
|
|||
__gnat_notify_unhandled_exception (excep);
|
||||
else
|
||||
__gnat_notify_handled_exception (excep);
|
||||
#endif
|
||||
|
||||
return _URC_HANDLER_FOUND;
|
||||
}
|
||||
|
|
@ -1195,10 +1216,12 @@ personality_body (_Unwind_Action uw_phases,
|
|||
setup_to_install
|
||||
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
|
||||
|
||||
#ifndef CERT
|
||||
/* Write current exception, so that it can be retrieved from Ada. It was
|
||||
already done during phase 1 (just above), but in between, one or several
|
||||
exceptions may have been raised (in cleanup handlers). */
|
||||
__gnat_setup_current_excep (uw_exception);
|
||||
#endif
|
||||
|
||||
return _URC_INSTALL_CONTEXT;
|
||||
}
|
||||
|
|
@ -1338,6 +1361,7 @@ PERSONALITY_FUNCTION (_Unwind_State state,
|
|||
/* Callback routine called by Unwind_ForcedUnwind to execute all the cleanup
|
||||
before exiting the task. */
|
||||
|
||||
#ifndef CERT
|
||||
_Unwind_Reason_Code
|
||||
__gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
|
||||
_Unwind_Action phases,
|
||||
|
|
@ -1362,6 +1386,7 @@ __gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
|
|||
and this hook will gain control again. */
|
||||
return _URC_NO_REASON;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Define the consistently named wrappers imported by Propagate_Exception. */
|
||||
|
||||
|
|
|
|||
|
|
@ -5158,6 +5158,8 @@ package body Sem_Attr is
|
|||
|
||||
Check_E0;
|
||||
|
||||
Check_Restriction (No_Dynamic_Priorities, N);
|
||||
|
||||
-- The prefix must be a protected object (AARM D.5.2 (2/2))
|
||||
|
||||
Analyze (P);
|
||||
|
|
|
|||
|
|
@ -393,7 +393,7 @@ package body Sem_Ch6 is
|
|||
Rewrite (N, New_Body);
|
||||
|
||||
-- Remove any existing aspects from the original node because the act
|
||||
-- of rewriting cases the list to be shared between the two nodes.
|
||||
-- of rewriting causes the list to be shared between the two nodes.
|
||||
|
||||
Orig_N := Original_Node (N);
|
||||
Remove_Aspects (Orig_N);
|
||||
|
|
@ -405,8 +405,8 @@ package body Sem_Ch6 is
|
|||
Relocate_Pragmas_To_Body (N);
|
||||
Analyze (N);
|
||||
|
||||
-- Once the aspects of the generated body has been analyzed, create a
|
||||
-- copy for ASIS purposes and assciate it with the original node.
|
||||
-- Once the aspects of the generated body have been analyzed, create
|
||||
-- a copy for ASIS purposes and associate it with the original node.
|
||||
|
||||
if Has_Aspects (N) then
|
||||
Set_Aspect_Specifications (Orig_N,
|
||||
|
|
@ -459,15 +459,15 @@ package body Sem_Ch6 is
|
|||
Rewrite (N, Make_Subprogram_Declaration (Loc, Specification => Spec));
|
||||
|
||||
-- Remove any existing aspects from the original node because the act
|
||||
-- of rewriting cases the list to be shared between the two nodes.
|
||||
-- of rewriting causes the list to be shared between the two nodes.
|
||||
|
||||
Orig_N := Original_Node (N);
|
||||
Remove_Aspects (Orig_N);
|
||||
|
||||
Analyze (N);
|
||||
|
||||
-- Once the aspects of the generated spec has been analyzed, create a
|
||||
-- copy for ASIS purposes and assciate it with the original node.
|
||||
-- Once the aspects of the generated spec have been analyzed, create
|
||||
-- a copy for ASIS purposes and associate it with the original node.
|
||||
|
||||
if Has_Aspects (N) then
|
||||
Set_Aspect_Specifications (Orig_N,
|
||||
|
|
|
|||
|
|
@ -6449,7 +6449,10 @@ package body Sem_Ch8 is
|
|||
-- Non-overloaded case
|
||||
|
||||
else
|
||||
if Is_Actual and then Present (Enclosing_Instance) then
|
||||
if Is_Actual
|
||||
and then Present (Enclosing_Instance)
|
||||
and then Entity_Matches_Spec (Entity (Nam), New_S)
|
||||
then
|
||||
Old_S := Entity (Nam);
|
||||
|
||||
elsif Entity_Matches_Spec (Entity (Nam), New_S) then
|
||||
|
|
@ -7757,6 +7760,7 @@ package body Sem_Ch8 is
|
|||
Next_Formal (New_F);
|
||||
Next_Formal (Old_F);
|
||||
end loop;
|
||||
pragma Assert (No (Old_F));
|
||||
|
||||
if Ekind_In (Old_S, E_Function, E_Enumeration_Literal) then
|
||||
Set_Etype (New_S, Etype (Old_S));
|
||||
|
|
|
|||
|
|
@ -7019,7 +7019,7 @@ package body Sem_Prag is
|
|||
|
||||
function Check_Node (N : Node_Id) return Traverse_Result;
|
||||
-- Tree visitor that checks if N is an attribute reference that can
|
||||
-- be statically computed by the backend. Validation_Needed is set
|
||||
-- be statically computed by the back end. Validation_Needed is set
|
||||
-- to True if found.
|
||||
|
||||
----------------
|
||||
|
|
@ -7063,10 +7063,10 @@ package body Sem_Prag is
|
|||
if Compile_Time_Known_Value (Arg1x) then
|
||||
Process_Compile_Time_Warning_Or_Error (N, Sloc (Arg1));
|
||||
|
||||
-- Register the expression for its validation after the backend has
|
||||
-- been called if it has occurrences of attributes size or alignment
|
||||
-- (because they may be statically computed by the backend and hence
|
||||
-- the whole expression needs to be re-evaluated).
|
||||
-- Register the expression for its validation after the back end has
|
||||
-- been called if it has occurrences of attributes Size or Alignment
|
||||
-- (because they may be statically computed by the back end and hence
|
||||
-- the whole expression needs to be reevaluated).
|
||||
|
||||
else
|
||||
Check_Expression (Arg1x);
|
||||
|
|
|
|||
|
|
@ -2008,7 +2008,7 @@ package Sinfo is
|
|||
-- Parent_Spec (Node4-Sem)
|
||||
-- For a library unit that is a child unit spec (package or subprogram
|
||||
-- declaration, generic declaration or instantiation, or library level
|
||||
-- rename, this field points to the compilation unit node for the parent
|
||||
-- rename) this field points to the compilation unit node for the parent
|
||||
-- package specification. This field is Empty for library bodies (the
|
||||
-- parent spec in this case can be found from the corresponding spec).
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue