+2014-10-20 Tristan Gingold <gingold@adacore.com>
+
+ * init.c (__gnat_is_stack_guard): Don't use mach_vm_region_recurse on
+ arm-darwin.
+ * raise-gcc.c: Add ATTRIBUTE_UNUSED to remove warnings for
+ unused arguments.
+
+2014-10-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute): Replace
+ variables CS and PS with Proc_Id and Subp_Id to better illustrate
+ their purpose. Account for the case where _Postconditions
+ has not been generated yet and the context is aspect/pragma
+ Refined_Post. In that scenario the expected prefix of attribute
+ 'Result is the current scope.
+
+2014-10-20 Robert Dewar <dewar@adacore.com>
+
+ * par-ch4.adb (P_Expression): Handle extraneous comma/semicolon
+ in middle of expression with logical operators.
+
+2014-10-20 Robert Dewar <dewar@adacore.com>
+
+ * par-ch13.adb (Possible_Misspelled_Aspect): New function.
+
+2014-10-20 Steve Baird <baird@adacore.com>
+
+ * pprint.adb: Improve Expression_Image function.
+
2014-10-20 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document No_Tagged_Streams pragma and aspect.
#include <stdlib.h>
#include <sys/syscall.h>
#include <sys/sysctl.h>
-#include <mach/mach_vm.h>
-#include <mach/mach_init.h>
-#include <mach/vm_statistics.h>
/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
Tell the kernel to re-use alt stack when delivering a signal. */
#define UC_RESET_ALT_STACK 0x80000000
+#ifndef __arm__
+#include <mach/mach_vm.h>
+#include <mach/mach_init.h>
+#include <mach/vm_statistics.h>
+#endif
+
/* Return true if ADDR is within a stack guard area. */
static int
__gnat_is_stack_guard (mach_vm_address_t addr)
{
+#ifndef __arm__
kern_return_t kret;
vm_region_submap_info_data_64_t info;
mach_vm_address_t start;
&& info.user_tag == VM_MEMORY_STACK)
return 1;
return 0;
+#else
+ /* Pagezero for arm. */
+ return addr < 4096;
+#endif
}
#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
Scan_State : Saved_Scan_State;
Result : Boolean;
+ function Possible_Misspelled_Aspect return Boolean;
+ -- Returns True, if Token_Name is a misspelling of some aspect name
+
+ --------------------------------
+ -- Possible_Misspelled_Aspect --
+ --------------------------------
+
+ function Possible_Misspelled_Aspect return Boolean is
+ begin
+ for J in Aspect_Id_Exclude_No_Aspect loop
+ if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end Possible_Misspelled_Aspect;
+
+ -- Start of processing for Aspect_Specifications_Present
+
begin
-- Definitely must have WITH to consider aspect specs to be present
if Token /= Tok_Identifier then
Result := False;
- -- This is where we pay attention to the Strict mode. Normally when we
- -- are in Ada 2012 mode, Strict is False, and we consider that we have
- -- an aspect specification if the identifier is an aspect name (even if
- -- not followed by =>) or the identifier is not an aspect name but is
- -- followed by =>, by a comma, or by a semicolon. The last two cases
- -- correspond to (misspelled) Boolean aspects with a defaulted value of
- -- True. P_Aspect_Specifications will generate messages if the aspect
+ -- This is where we pay attention to the Strict mode. Normally when
+ -- we are in Ada 2012 mode, Strict is False, and we consider that we
+ -- have an aspect specification if the identifier is an aspect name
+ -- or a likely misspelling of one (even if not followed by =>) or
+ -- the identifier is not an aspect name but is followed by =>, by
+ -- a comma, or by a semicolon. The last two cases correspond to
+ -- (misspelled) Boolean aspects with a defaulted value of True.
+ -- P_Aspect_Specifications will generate messages if the aspect
-- specification is ill-formed.
elsif not Strict then
- if Get_Aspect_Id (Token_Name) /= No_Aspect then
+ if Get_Aspect_Id (Token_Name) /= No_Aspect
+ or else Possible_Misspelled_Aspect
+ then
Result := True;
else
Scan; -- past identifier
Node1 := New_Op_Node (Logical_Op, Op_Location);
Set_Left_Opnd (Node1, Node2);
Set_Right_Opnd (Node1, P_Relation);
+
+ -- Check for case of errant comma or semicolon
+
+ if Token = Tok_Comma or else Token = Tok_Semicolon then
+ declare
+ Com : constant Boolean := Token = Tok_Comma;
+ Scan_State : Saved_Scan_State;
+ Logop : Node_Kind;
+
+ begin
+ Save_Scan_State (Scan_State); -- at comma/semicolon
+ Scan; -- past comma/semicolon
+
+ -- Check for AND THEN or OR ELSE after comma/semicolon. We
+ -- do not deal with AND/OR because those cases get mixed up
+ -- with the select alternatives case.
+
+ if Token = Tok_And or else Token = Tok_Or then
+ Logop := P_Logical_Operator;
+ Restore_Scan_State (Scan_State); -- to comma/semicolon
+
+ if Nkind_In (Logop, N_And_Then, N_Or_Else) then
+ Scan; -- past comma/semicolon
+
+ if Com then
+ Error_Msg_SP -- CODEFIX
+ ("|extra "","" ignored");
+ else
+ Error_Msg_SP -- CODEFIX
+ ("|extra "";"" ignored");
+ end if;
+
+ else
+ Restore_Scan_State (Scan_State); -- to comma/semicolon
+ end if;
+
+ else
+ Restore_Scan_State (Scan_State); -- to comma/semicolon
+ end if;
+ end;
+ end if;
+
exit when Token not in Token_Class_Logop;
end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 2008-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2014, 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- --
return List_Name
(First (Sinfo.Expressions (Expr)), Add_Space => False);
- elsif Null_Record_Present (Expr) then
+ -- Do not return empty string for (others => <>) aggregate
+ -- of a componentless record type. At least one caller (the
+ -- recursive call below in the N_Qualified_Expression case)
+ -- is not prepared to deal with a zero-length result.
+
+ elsif Null_Record_Present (Expr)
+ or else not Present (First (Component_Associations (Expr)))
+ then
return ("(null record)");
else
when N_Function_Call =>
if Present (Sinfo.Parameter_Associations (Right)) then
- Right :=
- Original_Node
- (Last (Sinfo.Parameter_Associations (Right)));
- Append_Paren := True;
+ declare
+ Rover : Node_Id;
+ Found : Boolean;
+
+ begin
+ -- Avoid source position confusion associated with
+ -- parameters for which Comes_From_Source is False.
+
+ Rover := First (Sinfo.Parameter_Associations (Right));
+ Found := False;
+ while Present (Rover) loop
+ if Comes_From_Source (Original_Node (Rover)) then
+ Right := Original_Node (Rover);
+ Append_Paren := True;
+ Found := True;
+ end if;
+
+ Next (Rover);
+ end loop;
+
+ -- Quit loop if no Comes_From_Source parameters
+
+ exit when not Found;
+ end;
- -- Quit loop if no named associations
+ -- Quit loop if no parameters
else
exit;
personality routine must unwind one frame (per EHABI 7.3 4.). */
static _Unwind_Reason_Code
-continue_unwind (struct _Unwind_Exception* ue_header,
- struct _Unwind_Context* uw_context)
+continue_unwind (struct _Unwind_Exception* ue_header ATTRIBUTE_UNUSED,
+ struct _Unwind_Context* uw_context ATTRIBUTE_UNUSED)
{
#ifdef __ARM_EABI_UNWINDER__
if (__gnu_unwind_frame (ue_header, uw_context) != _URC_OK)
Condition Handling Facility. */
int uw_version = (int) version_arg;
_Unwind_Action uw_phases = (_Unwind_Action) phases_arg;
- region_descriptor region;
- action_descriptor action;
- _Unwind_Ptr ip;
/* Check that we're called from the ABI context we expect, with a major
possible variation on VMS for IA64. */
}
_Unwind_Reason_Code
-__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
- void *handler,
- void *argument)
+__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
+ void *handler ATTRIBUTE_UNUSED,
+ void *argument ATTRIBUTE_UNUSED)
{
#ifdef __USING_SJLJ_EXCEPTIONS__
# if defined (__APPLE__) && defined (__arm__)
- /* There is not ForcedUnwind routine in ios system library. */
+ /* There is not ForcedUnwind routine in arm-darwin system library. */
return _URC_FATAL_PHASE1_ERROR;
# else
return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
Is_Empty_List (Static_Discrete_Predicate (P_Type)))
then
Error_Attr_P
- ("prefix of % attribute must be subtype with "
- & "at least one value");
+ ("prefix of % attribute must be subtype with at least one "
+ & "value");
end if;
end Check_First_Last_Valid;
------------
when Attribute_Result => Result : declare
- CS : Entity_Id;
- -- The enclosing scope, excluding loops for quantified expressions
-
- PS : Entity_Id;
- -- During analysis, CS is the postcondition subprogram and PS the
- -- source subprogram to which the postcondition applies. During
- -- pre-analysis, CS is the scope of the subprogram declaration.
+ Post_Id : Entity_Id;
+ -- The entity of the _Postconditions procedure
Prag : Node_Id;
-- During pre-analysis, Prag is the enclosing pragma node if any
+ Subp_Id : Entity_Id;
+ -- The entity of the enclosing subprogram
+
begin
-- Find the proper enclosing scope
- CS := Current_Scope;
- while Present (CS) loop
+ Post_Id := Current_Scope;
+ while Present (Post_Id) loop
-- Skip generated loops
- if Ekind (CS) = E_Loop then
- CS := Scope (CS);
+ if Ekind (Post_Id) = E_Loop then
+ Post_Id := Scope (Post_Id);
-- Skip the special _Parent scope generated to capture references
-- to formals during the process of subprogram inlining.
- elsif Ekind (CS) = E_Function
- and then Chars (CS) = Name_uParent
+ elsif Ekind (Post_Id) = E_Function
+ and then Chars (Post_Id) = Name_uParent
then
- CS := Scope (CS);
+ Post_Id := Scope (Post_Id);
+
+ -- Otherwise this must be _Postconditions
+
else
exit;
end if;
end loop;
- PS := Scope (CS);
+ Subp_Id := Scope (Post_Id);
-- If the enclosing subprogram is always inlined, the enclosing
-- postcondition will not be propagated to the expanded call.
if not In_Spec_Expression
- and then Has_Pragma_Inline_Always (PS)
+ and then Has_Pragma_Inline_Always (Subp_Id)
and then Warn_On_Redundant_Constructs
then
Error_Msg_N
-- or test case) pragma, and we just set the proper type. If there is
-- an error it will be caught when the real Analyze call is done.
- if Ekind (CS) = E_Function
- and then In_Spec_Expression
- then
+ if Ekind (Post_Id) = E_Function and then In_Spec_Expression then
+
-- Check OK prefix
- if Chars (CS) /= Chars (P) then
+ if Chars (Post_Id) /= Chars (P) then
Error_Msg_Name_1 := Name_Result;
-
Error_Msg_NE
- ("incorrect prefix for % attribute, expected &", P, CS);
+ ("incorrect prefix for % attribute, expected &", P, Post_Id);
Error_Attr;
end if;
else
case Get_Pragma_Id (Prag) is
-
when Pragma_Test_Case =>
declare
Arg_Ens : constant Node_Id :=
return;
end if;
- Set_Etype (N, Etype (CS));
+ Set_Etype (N, Etype (Post_Id));
-- If several functions with that name are visible, the intended
-- one is the current scope.
if Is_Overloaded (P) then
- Set_Entity (P, CS);
+ Set_Entity (P, Post_Id);
Set_Is_Overloaded (P, False);
end if;
-- then on the legality of 'Result is determined as usual.
elsif not Expander_Active and then In_Refined_Post then
- PS := Current_Scope;
- -- The prefix denotes the proper related function
+ -- Routine _Postconditions has not been generated yet, the nearest
+ -- enclosing subprogram is denoted by the current scope.
+
+ if Ekind (Post_Id) /= E_Procedure
+ or else Chars (Post_Id) /= Name_uPostconditions
+ then
+ Subp_Id := Current_Scope;
+ end if;
+
+ -- The prefix denotes the nearest enclosing function
if Is_Entity_Name (P)
and then Ekind (Entity (P)) = E_Function
- and then Entity (P) = PS
+ and then Entity (P) = Subp_Id
then
null;
+ -- Otherwise the use of 'Result is illegal
+
else
- Error_Msg_Name_2 := Chars (PS);
+ Error_Msg_Name_2 := Chars (Subp_Id);
Error_Attr ("incorrect prefix for % attribute, expected %", P);
end if;
- Set_Etype (N, Etype (PS));
+ Set_Etype (N, Etype (Subp_Id));
-- Body case, where we must be inside a generated _Postconditions
-- procedure, and the prefix must be on the scope stack, or else the
-- current one.
else
- while Present (CS) and then CS /= Standard_Standard loop
- if Chars (CS) = Name_uPostconditions then
+ while Present (Post_Id)
+ and then Post_Id /= Standard_Standard
+ loop
+ if Chars (Post_Id) = Name_uPostconditions then
exit;
else
- CS := Scope (CS);
+ Post_Id := Scope (Post_Id);
end if;
end loop;
- PS := Scope (CS);
+ Subp_Id := Scope (Post_Id);
- if Chars (CS) = Name_uPostconditions
- and then Ekind (PS) = E_Function
+ if Chars (Post_Id) = Name_uPostconditions
+ and then Ekind (Subp_Id) = E_Function
then
-- Check OK prefix
if Nkind_In (P, N_Identifier, N_Operator_Symbol)
- and then Chars (P) = Chars (PS)
+ and then Chars (P) = Chars (Subp_Id)
then
null;
elsif Is_Entity_Name (P)
and then Ekind (Entity (P)) = E_Function
and then Present (Alias (Entity (P)))
- and then Chars (Alias (Entity (P))) = Chars (PS)
+ and then Chars (Alias (Entity (P))) = Chars (Subp_Id)
then
null;
else
- Error_Msg_Name_2 := Chars (PS);
+ Error_Msg_Name_2 := Chars (Subp_Id);
Error_Attr
("incorrect prefix for % attribute, expected %", P);
end if;
Rewrite (N, Make_Identifier (Sloc (N), Name_uResult));
- Analyze_And_Resolve (N, Etype (PS));
+ Analyze_And_Resolve (N, Etype (Subp_Id));
else
Error_Attr
projects / gcc.git / commitdiff