diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 29 | ||||
| -rw-r--r-- | gcc/ada/g-sechas.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/lib-xref-spark_specific.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/raise-gcc.c | 29 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 2 |
11 files changed, 85 insertions, 24 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca438db..3f221d2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/g-sechas.adb b/gcc/ada/g-sechas.adb index f2e8d5d..59a598d 100644 --- a/gcc/ada/g-sechas.adb +++ b/gcc/ada/g-sechas.adb @@ -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)); diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 95056e0..87d3942 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -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. diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index b1d5978..ea68232 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -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 diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 5325fc0..4694853 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -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 diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index 4a10fbf..a2b6f64 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -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. */ diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7b31ca1..6695253 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 53ca284..ade6f50 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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, diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 45159c0..54fca50 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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)); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 26a4870..4351f32 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 659e989..75e0846 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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). |