[multiple changes]
2014-07-31 Robert Dewar <dewar@adacore.com> * exp_util.adb, lib-writ.adb, sem_ch12.adb, s-direio.adb: Minor reformatting. 2014-07-31 Hristian Kirtchev <kirtchev@adacore.com> * exp_attr.adb (Expand_Loop_Entry_Attribute): Update the comment which demonstrates the expansion of while loops subject to attribute 'Loop_Entry. The condition of a while loop along with related condition actions is now wrapped in a function. Instead of repeating the condition, the expansion now calls the function. 2014-07-31 Ed Schonberg <schonberg@adacore.com> * sem_case.adb (Check_Against_Predicate): Correct off-by-one error when reporting of missing values in a case statement for a type with a static predicate. (Check_Choices): Reject a choice given by a subtype to which a Dynamic_Predicate applies. * sem_ch3.adb (Analyze_Subtype_Declaration): Inherit Has_Dynamic_Predicate_Aspect flag from parent. 2014-07-31 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Analyze_Aspect_Specifications): A predicate cannot apply to a subtype of an incomplete type. (Is_Static_Choice): Treat an Others_Clause as static. The staticness of the expression and of the range are checked elsewhere. 2014-07-31 Pascal Obry <obry@adacore.com> * adaint.h (__gnat_ftell64): Added. (__gnat_fseek64): Added. (__int64): Added. * cstreams.c (__int64): Removed. From-SVN: r213366
This commit is contained in:
Arnaud Charlet
parent
d1e0e1480b
commit
fd7215d711
@ -1,3 +1,41 @@
|
||||
2014-07-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_util.adb, lib-writ.adb, sem_ch12.adb, s-direio.adb: Minor
|
||||
reformatting.
|
||||
|
||||
2014-07-31 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_attr.adb (Expand_Loop_Entry_Attribute): Update the comment
|
||||
which demonstrates the expansion of while loops subject to
|
||||
attribute 'Loop_Entry. The condition of a while loop along with
|
||||
related condition actions is now wrapped in a function. Instead
|
||||
of repeating the condition, the expansion now calls the function.
|
||||
|
||||
2014-07-31 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_case.adb (Check_Against_Predicate): Correct off-by-one
|
||||
error when reporting of missing values in a case statement for
|
||||
a type with a static predicate.
|
||||
(Check_Choices): Reject a choice given by a subtype to which a
|
||||
Dynamic_Predicate applies.
|
||||
* sem_ch3.adb (Analyze_Subtype_Declaration): Inherit
|
||||
Has_Dynamic_Predicate_Aspect flag from parent.
|
||||
|
||||
2014-07-31 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): A predicate
|
||||
cannot apply to a subtype of an incomplete type.
|
||||
(Is_Static_Choice): Treat an Others_Clause as static. The
|
||||
staticness of the expression and of the range are checked
|
||||
elsewhere.
|
||||
|
||||
2014-07-31 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* adaint.h (__gnat_ftell64): Added.
|
||||
(__gnat_fseek64): Added.
|
||||
(__int64): Added.
|
||||
* cstreams.c (__int64): Removed.
|
||||
|
||||
2014-07-31 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* a-stream.ads (Stream_Element_Offset): Now a signed 64bit type.
|
||||
|
||||
@ -72,6 +72,8 @@ typedef long long OS_Time;
|
||||
typedef long OS_Time;
|
||||
#endif
|
||||
|
||||
#define __int64 long long
|
||||
|
||||
/* A lazy cache for the attributes of a file. On some systems, a single call to
|
||||
stat() will give all this information, so it is better than doing a system
|
||||
call every time. On other systems this require several system calls.
|
||||
@ -251,6 +253,10 @@ extern int __gnat_set_close_on_exec (int, int);
|
||||
extern int __gnat_dup (int);
|
||||
extern int __gnat_dup2 (int, int);
|
||||
|
||||
/* large file support */
|
||||
extern __int64 __gnat_ftell64 (FILE *);
|
||||
extern int __gnat_fseek64 (FILE *, __int64, int);
|
||||
|
||||
extern int __gnat_number_of_cpus (void);
|
||||
|
||||
extern void __gnat_os_filename (char *, char *, char *,
|
||||
|
||||
@ -253,8 +253,6 @@ __gnat_full_name (char *nam, char *buffer)
|
||||
return buffer;
|
||||
}
|
||||
|
||||
#define __int64 long long
|
||||
|
||||
#ifdef _WIN32
|
||||
/* On Windows we want to use the fseek/fteel supporting large files. This
|
||||
issue is due to the fact that a long on Win64 is still a 32 bits value */
|
||||
|
||||
@ -1120,7 +1120,13 @@ package body Exp_Attr is
|
||||
|
||||
-- While loops are transformed into:
|
||||
|
||||
-- if <Condition> then
|
||||
-- function Fnn return Boolean is
|
||||
-- begin
|
||||
-- <condition actions>
|
||||
-- return <condition>;
|
||||
-- end Fnn;
|
||||
|
||||
-- if Fnn then
|
||||
-- declare
|
||||
-- Temp1 : constant <type of Pref1> := <Pref1>;
|
||||
-- . . .
|
||||
@ -1128,7 +1134,7 @@ package body Exp_Attr is
|
||||
-- begin
|
||||
-- loop
|
||||
-- <original source statements with attribute rewrites>
|
||||
-- exit when not <Condition>;
|
||||
-- exit when not Fnn;
|
||||
-- end loop;
|
||||
-- end;
|
||||
-- end if;
|
||||
@ -1138,23 +1144,81 @@ package body Exp_Attr is
|
||||
|
||||
elsif Present (Condition (Scheme)) then
|
||||
declare
|
||||
Cond : constant Node_Id := Condition (Scheme);
|
||||
Func_Decl : Node_Id;
|
||||
Func_Id : Entity_Id;
|
||||
Stmts : List_Id;
|
||||
|
||||
begin
|
||||
-- Wrap the condition of the while loop in a Boolean function.
|
||||
-- This avoids the duplication of the same code which may lead
|
||||
-- to gigi issues with respect to multiple declaration of the
|
||||
-- same entity in the presence of side effects or checks. Note
|
||||
-- that the condition actions must also be relocated to the
|
||||
-- wrapping function.
|
||||
|
||||
-- Generate:
|
||||
-- <condition actions>
|
||||
-- return <condition>;
|
||||
|
||||
if Present (Condition_Actions (Scheme)) then
|
||||
Stmts := Condition_Actions (Scheme);
|
||||
else
|
||||
Stmts := New_List;
|
||||
end if;
|
||||
|
||||
Append_To (Stmts,
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Expression => Relocate_Node (Condition (Scheme))));
|
||||
|
||||
-- Generate:
|
||||
-- function Fnn return Boolean is
|
||||
-- begin
|
||||
-- <Stmts>
|
||||
-- end Fnn;
|
||||
|
||||
Func_Id := Make_Temporary (Loc, 'F');
|
||||
Func_Decl :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification =>
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => Func_Id,
|
||||
Result_Definition =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc)),
|
||||
Declarations => Empty_List,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stmts));
|
||||
|
||||
-- The function is inserted before the related loop. Make sure
|
||||
-- to analyze it in the context of the loop's enclosing scope.
|
||||
|
||||
Push_Scope (Scope (Loop_Id));
|
||||
Insert_Action (Loop_Stmt, Func_Decl);
|
||||
Pop_Scope;
|
||||
|
||||
-- Transform the original while loop into an infinite loop
|
||||
-- where the last statement checks the negated condition. This
|
||||
-- placement ensures that the condition will not be evaluated
|
||||
-- twice on the first iteration.
|
||||
|
||||
Set_Iteration_Scheme (Loop_Stmt, Empty);
|
||||
Scheme := Empty;
|
||||
|
||||
-- Generate:
|
||||
-- exit when not <Cond>:
|
||||
-- exit when not Fnn;
|
||||
|
||||
Append_To (Statements (Loop_Stmt),
|
||||
Make_Exit_Statement (Loc,
|
||||
Condition => Make_Op_Not (Loc, New_Copy_Tree (Cond))));
|
||||
Condition =>
|
||||
Make_Op_Not (Loc,
|
||||
Right_Opnd =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (Func_Id, Loc)))));
|
||||
|
||||
Build_Conditional_Block (Loc,
|
||||
Cond => Relocate_Node (Cond),
|
||||
Cond =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (Func_Id, Loc)),
|
||||
Loop_Stmt => Relocate_Node (Loop_Stmt),
|
||||
If_Stmt => Result,
|
||||
Blk_Stmt => Blk);
|
||||
@ -1289,8 +1353,6 @@ package body Exp_Attr is
|
||||
|
||||
-- Step 4: Analyze all bits
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Temp_Id, Loc));
|
||||
|
||||
Installed := Current_Scope = Scope (Loop_Id);
|
||||
|
||||
-- Depending on the pracement of attribute 'Loop_Entry relative to the
|
||||
@ -1305,19 +1367,6 @@ package body Exp_Attr is
|
||||
|
||||
if Present (Result) then
|
||||
Rewrite (Loop_Stmt, Result);
|
||||
|
||||
-- The insertion of condition actions associated with an iteration
|
||||
-- scheme is usually done by the expansion of loop statements. The
|
||||
-- expansion of Loop_Entry however reuses the iteration scheme to
|
||||
-- build an if statement. As a result any condition actions must be
|
||||
-- inserted before the if statement to avoid references before
|
||||
-- declaration.
|
||||
|
||||
if Present (Scheme) and then Present (Condition_Actions (Scheme)) then
|
||||
Insert_Actions (Loop_Stmt, Condition_Actions (Scheme));
|
||||
Set_Condition_Actions (Scheme, No_List);
|
||||
end if;
|
||||
|
||||
Analyze (Loop_Stmt);
|
||||
|
||||
-- The conditional block was analyzed when a previous 'Loop_Entry was
|
||||
@ -1328,6 +1377,7 @@ package body Exp_Attr is
|
||||
Analyze (Temp_Decl);
|
||||
end if;
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Temp_Id, Loc));
|
||||
Analyze (N);
|
||||
|
||||
if not Installed then
|
||||
|
||||
@ -3325,7 +3325,6 @@ package body Exp_Util is
|
||||
function Has_Annotate_Pragma_For_External_Axiomatization
|
||||
(E : Entity_Id) return Boolean
|
||||
is
|
||||
|
||||
function Is_Annotate_Pragma_For_External_Axiomatization
|
||||
(N : Node_Id) return Boolean;
|
||||
-- Returns whether N is
|
||||
@ -3352,15 +3351,14 @@ package body Exp_Util is
|
||||
-- pragma Annotate (GNATprove, External_Axiomatization);
|
||||
|
||||
function Is_Annotate_Pragma_For_External_Axiomatization
|
||||
(N : Node_Id) return Boolean is
|
||||
|
||||
-------------------
|
||||
-- Special Names --
|
||||
-------------------
|
||||
|
||||
Name_GNATprove : constant String := "gnatprove";
|
||||
(N : Node_Id) return Boolean
|
||||
is
|
||||
Name_GNATprove : constant String :=
|
||||
"gnatprove";
|
||||
Name_External_Axiomatization : constant String :=
|
||||
"external_axiomatization";
|
||||
"external_axiomatization";
|
||||
-- Special names
|
||||
|
||||
begin
|
||||
if Nkind (N) = N_Pragma
|
||||
and then Get_Pragma_Id (Pragma_Name (N)) = Pragma_Annotate
|
||||
@ -3368,10 +3366,11 @@ package body Exp_Util is
|
||||
then
|
||||
declare
|
||||
Arg1 : constant Node_Id :=
|
||||
First (Pragma_Argument_Associations (N));
|
||||
First (Pragma_Argument_Associations (N));
|
||||
Arg2 : constant Node_Id := Next (Arg1);
|
||||
Nam1 : Name_Id;
|
||||
Nam2 : Name_Id;
|
||||
|
||||
begin
|
||||
-- Fill in Name_Buffer with Name_GNATprove first, and then with
|
||||
-- Name_External_Axiomatization so that Name_Find returns the
|
||||
@ -3386,8 +3385,8 @@ package body Exp_Util is
|
||||
Nam2 := Name_Find;
|
||||
|
||||
return Chars (Get_Pragma_Arg (Arg1)) = Nam1
|
||||
and then
|
||||
Chars (Get_Pragma_Arg (Arg2)) = Nam2;
|
||||
and then
|
||||
Chars (Get_Pragma_Arg (Arg2)) = Nam2;
|
||||
end;
|
||||
|
||||
else
|
||||
@ -3395,10 +3394,14 @@ package body Exp_Util is
|
||||
end if;
|
||||
end Is_Annotate_Pragma_For_External_Axiomatization;
|
||||
|
||||
Decl : Node_Id;
|
||||
-- Local variables
|
||||
|
||||
Decl : Node_Id;
|
||||
Vis_Decls : List_Id;
|
||||
N : Node_Id;
|
||||
|
||||
-- Start of processing for Has_Annotate_Pragma_For_External_Axiomatization
|
||||
|
||||
begin
|
||||
if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
|
||||
Decl := Parent (Parent (E));
|
||||
|
||||
@ -662,8 +662,7 @@ package body Lib.Writ is
|
||||
-- compilation unit.
|
||||
|
||||
begin
|
||||
if U /= No_Unit
|
||||
and then Nkind (Unit (Cunit (U))) = N_Subunit
|
||||
if U /= No_Unit and then Nkind (Unit (Cunit (U))) = N_Subunit
|
||||
then
|
||||
Note_Unit := Main_Unit;
|
||||
else
|
||||
|
||||
@ -282,8 +282,9 @@ package body System.Direct_IO is
|
||||
procedure Set_Position (File : File_Type) is
|
||||
R : int;
|
||||
begin
|
||||
R := fseek64
|
||||
(File.Stream, int64 (File.Bytes) * int64 (File.Index - 1), SEEK_SET);
|
||||
R :=
|
||||
fseek64
|
||||
(File.Stream, int64 (File.Bytes) * int64 (File.Index - 1), SEEK_SET);
|
||||
|
||||
if R /= 0 then
|
||||
raise Use_Error;
|
||||
@ -296,6 +297,7 @@ package body System.Direct_IO is
|
||||
|
||||
function Size (File : File_Type) return Count is
|
||||
Pos : int64;
|
||||
|
||||
begin
|
||||
FIO.Check_File_Open (AP (File));
|
||||
File.Last_Op := Op_Other;
|
||||
|
||||
@ -433,9 +433,10 @@ package body Sem_Case is
|
||||
Error := True;
|
||||
|
||||
-- The previous choice covered part of the static predicate set
|
||||
-- but there is a gap after Prev_Hi.
|
||||
|
||||
else
|
||||
Missing_Choice (Prev_Hi, Choice_Lo - 1);
|
||||
Missing_Choice (Prev_Hi + 1, Choice_Lo - 1);
|
||||
Error := True;
|
||||
end if;
|
||||
end if;
|
||||
@ -1462,6 +1463,7 @@ package body Sem_Case is
|
||||
|
||||
if not Is_Discrete_Type (E)
|
||||
or else not Has_Static_Predicate (E)
|
||||
or else Has_Dynamic_Predicate_Aspect (E)
|
||||
then
|
||||
Bad_Predicated_Subtype_Use
|
||||
("cannot use subtype& with non-static "
|
||||
|
||||
@ -1018,17 +1018,17 @@ package body Sem_Ch12 is
|
||||
(Formal : Entity_Id;
|
||||
Actual : Entity_Id := Empty) return Node_Id
|
||||
is
|
||||
Loc : constant Source_Ptr := Sloc (I_Node);
|
||||
Typ : constant Entity_Id := Etype (Formal);
|
||||
Loc : constant Source_Ptr := Sloc (I_Node);
|
||||
Typ : constant Entity_Id := Etype (Formal);
|
||||
Is_Binary : constant Boolean :=
|
||||
Present (Next_Formal (First_Formal (Formal)));
|
||||
Present (Next_Formal (First_Formal (Formal)));
|
||||
|
||||
Decl : Node_Id;
|
||||
Expr : Node_Id;
|
||||
F1, F2 : Entity_Id;
|
||||
Func : Entity_Id;
|
||||
Decl : Node_Id;
|
||||
Expr : Node_Id;
|
||||
F1, F2 : Entity_Id;
|
||||
Func : Entity_Id;
|
||||
Op_Name : Name_Id;
|
||||
Spec : Node_Id;
|
||||
Spec : Node_Id;
|
||||
|
||||
L, R : Node_Id;
|
||||
|
||||
@ -1050,23 +1050,24 @@ package body Sem_Ch12 is
|
||||
Set_Ekind (Func, E_Function);
|
||||
Set_Is_Generic_Actual_Subprogram (Func);
|
||||
|
||||
Spec := Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => Func,
|
||||
|
||||
Parameter_Specifications => New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => F1,
|
||||
Parameter_Type => Make_Identifier
|
||||
(Loc, Chars (Etype (First_Formal (Formal)))))),
|
||||
|
||||
Result_Definition => Make_Identifier (Loc, Chars (Typ)));
|
||||
Spec :=
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => Func,
|
||||
Parameter_Specifications => New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => F1,
|
||||
Parameter_Type =>
|
||||
Make_Identifier (Loc,
|
||||
Chars => Chars (Etype (First_Formal (Formal)))))),
|
||||
Result_Definition => Make_Identifier (Loc, Chars (Typ)));
|
||||
|
||||
if Is_Binary then
|
||||
Append_To (Parameter_Specifications (Spec),
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => F2,
|
||||
Parameter_Type => Make_Identifier (Loc,
|
||||
Chars (Etype (Next_Formal (First_Formal (Formal)))))));
|
||||
Parameter_Type =>
|
||||
Make_Identifier (Loc,
|
||||
Chars (Etype (Next_Formal (First_Formal (Formal)))))));
|
||||
end if;
|
||||
|
||||
-- Build expression as a function call, or as an operator node
|
||||
@ -1074,86 +1075,73 @@ package body Sem_Ch12 is
|
||||
-- operators.
|
||||
|
||||
if Present (Actual) and then Op_Name not in Any_Operator_Name then
|
||||
Expr := Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (Entity (Actual), Loc),
|
||||
Parameter_Associations => New_List (L));
|
||||
Expr :=
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (Entity (Actual), Loc),
|
||||
Parameter_Associations => New_List (L));
|
||||
|
||||
if Is_Binary then
|
||||
Append_To (Parameter_Associations (Expr), R);
|
||||
end if;
|
||||
|
||||
-- Binary operators
|
||||
|
||||
elsif Is_Binary then
|
||||
if Op_Name = Name_Op_And then
|
||||
Expr := Make_Op_And (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Or then
|
||||
Expr := Make_Op_Or (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Xor then
|
||||
Expr := Make_Op_Xor (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Eq then
|
||||
Expr := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Ne then
|
||||
Expr := Make_Op_Ne (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Le then
|
||||
Expr := Make_Op_Le (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Gt then
|
||||
Expr := Make_Op_Gt (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Ge then
|
||||
Expr := Make_Op_Ge (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Lt then
|
||||
Expr := Make_Op_Lt (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Add then
|
||||
Expr := Make_Op_Add (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Subtract then
|
||||
Expr := Make_Op_Subtract (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Concat then
|
||||
Expr := Make_Op_Concat (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Multiply then
|
||||
Expr := Make_Op_Multiply (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Divide then
|
||||
Expr := Make_Op_Divide (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Mod then
|
||||
Expr := Make_Op_Mod (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Rem then
|
||||
Expr := Make_Op_Rem (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
|
||||
elsif Op_Name = Name_Op_Expon then
|
||||
Expr := Make_Op_Expon (Loc, Left_Opnd => L, Right_Opnd => R);
|
||||
end if;
|
||||
|
||||
else -- Unary operators.
|
||||
-- Unary operators
|
||||
|
||||
else
|
||||
if Op_Name = Name_Op_Add then
|
||||
Expr := Make_Op_Plus (Loc, Right_Opnd => L);
|
||||
|
||||
elsif Op_Name = Name_Op_Subtract then
|
||||
Expr := Make_Op_Minus (Loc, Right_Opnd => L);
|
||||
|
||||
elsif Op_Name = Name_Op_Abs then
|
||||
Expr := Make_Op_Abs (Loc, Right_Opnd => L);
|
||||
|
||||
elsif Op_Name = Name_Op_Not then
|
||||
Expr := Make_Op_Not (Loc, Right_Opnd => L);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Decl := Make_Expression_Function (Loc,
|
||||
Specification => Spec,
|
||||
Expression => Expr);
|
||||
Decl :=
|
||||
Make_Expression_Function (Loc,
|
||||
Specification => Spec,
|
||||
Expression => Expr);
|
||||
|
||||
return Decl;
|
||||
end Build_Wrapper;
|
||||
|
||||
@ -1787,6 +1787,11 @@ package body Sem_Ch13 is
|
||||
("predicate can only be specified for a subtype",
|
||||
Aspect);
|
||||
goto Continue;
|
||||
|
||||
elsif Is_Incomplete_Type (E) then
|
||||
Error_Msg_N
|
||||
("predicate cannot apply to incomplete view", Aspect);
|
||||
goto Continue;
|
||||
end if;
|
||||
|
||||
-- Construct the pragma (always a pragma Predicate, with
|
||||
@ -3544,8 +3549,9 @@ package body Sem_Ch13 is
|
||||
if Ekind (Current_Scope) = E_Package
|
||||
and then Has_Private_Declaration (Ent)
|
||||
and then From_Aspect_Specification (N)
|
||||
and then List_Containing (Parent (Ent))
|
||||
= Private_Declarations
|
||||
and then
|
||||
List_Containing (Parent (Ent)) =
|
||||
Private_Declarations
|
||||
(Specification (Unit_Declaration_Node (Current_Scope)))
|
||||
and then Nkind (N) = N_Attribute_Definition_Clause
|
||||
then
|
||||
@ -3555,8 +3561,8 @@ package body Sem_Ch13 is
|
||||
begin
|
||||
Decl :=
|
||||
First (Visible_Declarations
|
||||
(Specification
|
||||
(Unit_Declaration_Node (Current_Scope))));
|
||||
(Specification
|
||||
(Unit_Declaration_Node (Current_Scope))));
|
||||
|
||||
while Present (Decl) loop
|
||||
if Nkind (Decl) = N_Private_Type_Declaration
|
||||
@ -3566,7 +3572,7 @@ package body Sem_Ch13 is
|
||||
then
|
||||
Illegal_Indexing
|
||||
("Indexing aspect cannot be specified on full view "
|
||||
& "if partial view is tagged");
|
||||
& "if partial view is tagged");
|
||||
return;
|
||||
end if;
|
||||
|
||||
@ -3678,9 +3684,7 @@ package body Sem_Ch13 is
|
||||
end;
|
||||
end if;
|
||||
|
||||
if not Indexing_Found
|
||||
and then not Error_Posted (N)
|
||||
then
|
||||
if not Indexing_Found and then not Error_Posted (N) then
|
||||
Error_Msg_NE
|
||||
("aspect Indexing requires a local function that "
|
||||
& "applies to type&", Expr, Ent);
|
||||
@ -10618,6 +10622,8 @@ package body Sem_Ch13 is
|
||||
-- Returns true if all elements of the list are OK static choices
|
||||
-- as defined below for Is_Static_Choice. Used for case expression
|
||||
-- alternatives and for the right operand of a membership test.
|
||||
-- An others_choice is static if the corresponding expression is static.
|
||||
-- The staticness of the bounds is checked separately.
|
||||
|
||||
function Is_Static_Choice (N : Node_Id) return Boolean;
|
||||
-- Returns True if N represents a static choice (static subtype, or
|
||||
@ -10683,7 +10689,8 @@ package body Sem_Ch13 is
|
||||
|
||||
function Is_Static_Choice (N : Node_Id) return Boolean is
|
||||
begin
|
||||
return Is_OK_Static_Expression (N)
|
||||
return Nkind (N) = N_Others_Choice
|
||||
or else Is_OK_Static_Expression (N)
|
||||
or else (Is_Entity_Name (N) and then Is_Type (Entity (N))
|
||||
and then Is_OK_Static_Subtype (Entity (N)))
|
||||
or else (Nkind (N) = N_Subtype_Indication
|
||||
|
||||
@ -4514,6 +4514,8 @@ package body Sem_Ch3 is
|
||||
|
||||
when Enumeration_Kind =>
|
||||
Set_Ekind (Id, E_Enumeration_Subtype);
|
||||
Set_Has_Dynamic_Predicate_Aspect (Id,
|
||||
Has_Dynamic_Predicate_Aspect (T));
|
||||
Set_First_Literal (Id, First_Literal (Base_Type (T)));
|
||||
Set_Scalar_Range (Id, Scalar_Range (T));
|
||||
Set_Is_Character_Type (Id, Is_Character_Type (T));
|
||||
|
||||
Loading…
Reference in New Issue
Block a user