+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
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));
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.
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
-- 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
* *
* 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- *
#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;
(_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. */
/* 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')
if (choice_typeinfo == except_typeinfo)
return handler;
}
+#endif
return nothing;
}
}
else
{
+#ifndef CERT
struct Exception_Occurrence *excep;
/* Trigger the appropriate notification routines before the second
__gnat_notify_unhandled_exception (excep);
else
__gnat_notify_handled_exception (excep);
+#endif
return _URC_HANDLER_FOUND;
}
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;
}
/* 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,
and this hook will gain control again. */
return _URC_NO_REASON;
}
+#endif
/* Define the consistently named wrappers imported by Propagate_Exception. */
Check_E0;
+ Check_Restriction (No_Dynamic_Priorities, N);
+
-- The prefix must be a protected object (AARM D.5.2 (2/2))
Analyze (P);
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);
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,
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,
-- 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
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));
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.
----------------
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);
-- 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).
projects / gcc.git / commitdiff