Commit a905304c by Arnaud Charlet

[multiple changes]

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.

From-SVN: r216477
parent 49d41397
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.
......
......@@ -2198,9 +2198,6 @@ __gnat_install_handler(void)
#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 */
......@@ -2209,10 +2206,17 @@ 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;
......@@ -2232,6 +2236,10 @@ __gnat_is_stack_guard (mach_vm_address_t addr)
&& 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
......
......@@ -45,6 +45,26 @@ package body Ch13 is
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
......@@ -74,17 +94,20 @@ package body Ch13 is
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
......
......@@ -1708,6 +1708,48 @@ package body Ch4 is
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;
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -226,7 +226,14 @@ package body Pprint is
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
......@@ -585,12 +592,32 @@ package body Pprint is
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;
......
......@@ -1110,8 +1110,8 @@ extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
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)
......@@ -1253,9 +1253,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
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. */
......@@ -1379,14 +1376,14 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *e)
}
_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);
......
......@@ -1509,8 +1509,8 @@ package body Sem_Attr is
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;
......@@ -4946,47 +4946,48 @@ package body Sem_Attr is
------------
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
......@@ -4998,16 +4999,14 @@ package body Sem_Attr is
-- 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;
......@@ -5041,7 +5040,6 @@ package body Sem_Attr is
else
case Get_Pragma_Id (Prag) is
when Pragma_Test_Case =>
declare
Arg_Ens : constant Node_Id :=
......@@ -5114,13 +5112,13 @@ package body Sem_Attr is
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;
......@@ -5132,22 +5130,32 @@ package body Sem_Attr is
-- 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
......@@ -5156,23 +5164,25 @@ package body Sem_Attr is
-- 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;
......@@ -5182,18 +5192,18 @@ package body Sem_Attr is
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
......
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