[multiple changes]
2014-07-18 Robert Dewar <dewar@adacore.com> * bcheck.adb (Check_Consistent_Restrictions): Remove obsolete code checking for violation of No_Standard_Allocators_After_Elaboration (main program) * bindgen.adb (Gen_Adainit): Handle No_Standard_Allocators_After_Elaboration (Gen_Output_File_Ada): ditto. * exp_ch4.adb (Expand_N_Allocator): Handle No_Standard_Allocators_After_Elaboration. * Makefile.rtl: Add entry for s-elaall * rtsfind.ads: Add entry for Check_Standard_Allocator. * s-elaall.ads, s-elaall.adb: New files. * sem_ch4.adb (Analyze_Allocator): Handle No_Standard_Allocators_After_Elaboration. 2014-07-18 Robert Dewar <dewar@adacore.com> * lib.adb, lib.ads, lib-writ.adb, lib-writ.ads, ali.adb, ali.ads, lib-load.adb: Remove Lib.Has_Allocator and all uses. Remove AB parameter from ali files and all uses. Remove Allocator_In_Body and all uses. 2014-07-18 Robert Dewar <dewar@adacore.com> * g-expect-vms.adb: Add comment. 2014-07-18 Thomas Quinot <quinot@adacore.com> * par_sco.adb (Is_Logical_Operation): return True for N_If_Expression. 2014-07-18 Ed Schonberg <schonberg@adacore.com> * sem_attr.adb (Resolve_Attribute, case 'Update): Do full analysis and resolution of each choice in the associations within the argument of Update, because they may be variable names. 2014-07-18 Hristian Kirtchev <kirtchev@adacore.com> * exp_attr.adb (Expand_Loop_Entry_Attribute): Insert any condition actions before the generated if statement. 2014-07-18 Hristian Kirtchev <kirtchev@adacore.com> * gnat_ugn.texi Enhance the documentation of switches -gnateA and -gnateV. 2014-07-18 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Build_Default_Subtype): Add missing condition so that code matches description: use the full view of the base only if the base is private and the subtype is not. From-SVN: r212779
This commit is contained in:
parent
537b531270
commit
b3b26ace90
|
@ -1,3 +1,57 @@
|
||||||
|
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* bcheck.adb (Check_Consistent_Restrictions):
|
||||||
|
Remove obsolete code checking for violation of
|
||||||
|
No_Standard_Allocators_After_Elaboration (main program)
|
||||||
|
* bindgen.adb (Gen_Adainit): Handle
|
||||||
|
No_Standard_Allocators_After_Elaboration
|
||||||
|
(Gen_Output_File_Ada): ditto.
|
||||||
|
* exp_ch4.adb (Expand_N_Allocator): Handle
|
||||||
|
No_Standard_Allocators_After_Elaboration.
|
||||||
|
* Makefile.rtl: Add entry for s-elaall
|
||||||
|
* rtsfind.ads: Add entry for Check_Standard_Allocator.
|
||||||
|
* s-elaall.ads, s-elaall.adb: New files.
|
||||||
|
* sem_ch4.adb (Analyze_Allocator): Handle
|
||||||
|
No_Standard_Allocators_After_Elaboration.
|
||||||
|
|
||||||
|
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* lib.adb, lib.ads, lib-writ.adb, lib-writ.ads, ali.adb,
|
||||||
|
ali.ads, lib-load.adb: Remove Lib.Has_Allocator and all uses.
|
||||||
|
Remove AB parameter from ali files and all uses.
|
||||||
|
Remove Allocator_In_Body and all uses.
|
||||||
|
|
||||||
|
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* g-expect-vms.adb: Add comment.
|
||||||
|
|
||||||
|
2014-07-18 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
|
* par_sco.adb (Is_Logical_Operation): return True for
|
||||||
|
N_If_Expression.
|
||||||
|
|
||||||
|
2014-07-18 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_attr.adb (Resolve_Attribute, case 'Update): Do full
|
||||||
|
analysis and resolution of each choice in the associations within
|
||||||
|
the argument of Update, because they may be variable names.
|
||||||
|
|
||||||
|
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* exp_attr.adb (Expand_Loop_Entry_Attribute): Insert any condition
|
||||||
|
actions before the generated if statement.
|
||||||
|
|
||||||
|
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* gnat_ugn.texi Enhance the documentation of
|
||||||
|
switches -gnateA and -gnateV.
|
||||||
|
|
||||||
|
2014-07-18 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_util.adb (Build_Default_Subtype): Add missing condition
|
||||||
|
so that code matches description: use the full view of the base
|
||||||
|
only if the base is private and the subtype is not.
|
||||||
|
|
||||||
2014-07-17 Gary Dismukes <dismukes@adacore.com>
|
2014-07-17 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
* exp_disp.adb: Minor reformatting.
|
* exp_disp.adb: Minor reformatting.
|
||||||
|
|
|
@ -518,6 +518,7 @@ GNATRTL_NONTASKING_OBJS= \
|
||||||
s-direio$(objext) \
|
s-direio$(objext) \
|
||||||
s-dmotpr$(objext) \
|
s-dmotpr$(objext) \
|
||||||
s-dsaser$(objext) \
|
s-dsaser$(objext) \
|
||||||
|
s-elaall$(objext) \
|
||||||
s-excdeb$(objext) \
|
s-excdeb$(objext) \
|
||||||
s-except$(objext) \
|
s-except$(objext) \
|
||||||
s-exctab$(objext) \
|
s-exctab$(objext) \
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -894,7 +894,6 @@ package body ALI is
|
||||||
Sfile => No_File,
|
Sfile => No_File,
|
||||||
Task_Dispatching_Policy => ' ',
|
Task_Dispatching_Policy => ' ',
|
||||||
Time_Slice_Value => -1,
|
Time_Slice_Value => -1,
|
||||||
Allocator_In_Body => False,
|
|
||||||
WC_Encoding => 'b',
|
WC_Encoding => 'b',
|
||||||
Unit_Exception_Table => False,
|
Unit_Exception_Table => False,
|
||||||
Ver => (others => ' '),
|
Ver => (others => ' '),
|
||||||
|
@ -977,14 +976,6 @@ package body ALI is
|
||||||
|
|
||||||
Skip_Space;
|
Skip_Space;
|
||||||
|
|
||||||
if Nextc = 'A' then
|
|
||||||
P := P + 1;
|
|
||||||
Checkc ('B');
|
|
||||||
ALIs.Table (Id).Allocator_In_Body := True;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Skip_Space;
|
|
||||||
|
|
||||||
if Nextc = 'C' then
|
if Nextc = 'C' then
|
||||||
P := P + 1;
|
P := P + 1;
|
||||||
Checkc ('=');
|
Checkc ('=');
|
||||||
|
|
|
@ -142,10 +142,6 @@ package ALI is
|
||||||
-- line. A value of -1 indicates that no T=xxx parameter was found, or
|
-- line. A value of -1 indicates that no T=xxx parameter was found, or
|
||||||
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
|
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
|
||||||
|
|
||||||
Allocator_In_Body : Boolean;
|
|
||||||
-- Set True if an AB switch appears on the main program line. False
|
|
||||||
-- if no M line, or AB not present, or 'M appears in Ignore_Lines.
|
|
||||||
|
|
||||||
WC_Encoding : Character;
|
WC_Encoding : Character;
|
||||||
-- Wide character encoding if main procedure. Otherwise not relevant.
|
-- Wide character encoding if main procedure. Otherwise not relevant.
|
||||||
-- Not set if 'M' appears in Ignore_Lines.
|
-- Not set if 'M' appears in Ignore_Lines.
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -923,21 +923,18 @@ package body Bcheck is
|
||||||
-- Start of processing for Check_Consistent_Restrictions
|
-- Start of processing for Check_Consistent_Restrictions
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- A special test, if we have a main program, then if it has an
|
-- We used to have a special test here:
|
||||||
-- allocator in the body, this is considered to be a violation of
|
|
||||||
-- the restriction No_Allocators_After_Elaboration. We just mark
|
|
||||||
-- this restriction and then the normal circuit will flag it.
|
|
||||||
|
|
||||||
if Bind_Main_Program
|
-- A special test, if we have a main program, then if it has an
|
||||||
and then ALIs.Table (ALIs.First).Main_Program /= None
|
-- allocator in the body, this is considered to be a violation of
|
||||||
and then not No_Main_Subprogram
|
-- the restriction No_Allocators_After_Elaboration. We just mark
|
||||||
and then ALIs.Table (ALIs.First).Allocator_In_Body
|
-- this restriction and then the normal circuit will flag it.
|
||||||
then
|
|
||||||
Cumulative_Restrictions.Violated
|
-- But we don't do that any more, because in the final version of Ada
|
||||||
(No_Standard_Allocators_After_Elaboration) := True;
|
-- 2012, it is statically illegal to have an allocator in a library-
|
||||||
ALIs.Table (ALIs.First).Restrictions.Violated
|
-- level subprogram, so we don't need this bind time test any more.
|
||||||
(No_Standard_Allocators_After_Elaboration) := True;
|
-- If we have a main program with parameters (which GNAT allows), then
|
||||||
end if;
|
-- allocators in that will be caught by the run-time check.
|
||||||
|
|
||||||
-- Loop through all restriction violations
|
-- Loop through all restriction violations
|
||||||
|
|
||||||
|
|
|
@ -739,8 +739,8 @@ package body Bindgen is
|
||||||
if Dispatching_Domains_Used then
|
if Dispatching_Domains_Used then
|
||||||
WBI (" procedure Freeze_Dispatching_Domains;");
|
WBI (" procedure Freeze_Dispatching_Domains;");
|
||||||
WBI (" pragma Import");
|
WBI (" pragma Import");
|
||||||
WBI (" (Ada, Freeze_Dispatching_Domains, " &
|
WBI (" (Ada, Freeze_Dispatching_Domains, "
|
||||||
"""__gnat_freeze_dispatching_domains"");");
|
& """__gnat_freeze_dispatching_domains"");");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
WBI (" begin");
|
WBI (" begin");
|
||||||
|
@ -749,6 +749,18 @@ package body Bindgen is
|
||||||
WBI (" end if;");
|
WBI (" end if;");
|
||||||
WBI (" Is_Elaborated := True;");
|
WBI (" Is_Elaborated := True;");
|
||||||
|
|
||||||
|
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
|
||||||
|
-- restriction No_Standard_Allocators_After_Elaboration is active.
|
||||||
|
|
||||||
|
if Cumulative_Restrictions.Set
|
||||||
|
(No_Standard_Allocators_After_Elaboration)
|
||||||
|
then
|
||||||
|
WBI (" System.Elaboration_Allocators."
|
||||||
|
& "Mark_Start_Of_Elaboration;");
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Generate assignments to initialize globals
|
||||||
|
|
||||||
Set_String (" Main_Priority := ");
|
Set_String (" Main_Priority := ");
|
||||||
Set_Int (Main_Priority);
|
Set_Int (Main_Priority);
|
||||||
Set_Char (';');
|
Set_Char (';');
|
||||||
|
@ -996,6 +1008,15 @@ package body Bindgen is
|
||||||
|
|
||||||
Gen_Elab_Calls;
|
Gen_Elab_Calls;
|
||||||
|
|
||||||
|
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
|
||||||
|
-- restriction No_Standard_Allocators_After_Elaboration is active.
|
||||||
|
|
||||||
|
if Cumulative_Restrictions.Set
|
||||||
|
(No_Standard_Allocators_After_Elaboration)
|
||||||
|
then
|
||||||
|
WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;");
|
||||||
|
end if;
|
||||||
|
|
||||||
-- From this point, no new dispatching domain can be created.
|
-- From this point, no new dispatching domain can be created.
|
||||||
|
|
||||||
if Dispatching_Domains_Used then
|
if Dispatching_Domains_Used then
|
||||||
|
@ -2482,10 +2503,23 @@ package body Bindgen is
|
||||||
WBI ("with System.Restrictions;");
|
WBI ("with System.Restrictions;");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Generate with of Ada.Exceptions if needs library finalization
|
||||||
|
|
||||||
if Needs_Library_Finalization then
|
if Needs_Library_Finalization then
|
||||||
WBI ("with Ada.Exceptions;");
|
WBI ("with Ada.Exceptions;");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Generate with of System.Elaboration_Allocators if the restriction
|
||||||
|
-- No_Standard_Allocators_After_Elaboration was present.
|
||||||
|
|
||||||
|
if Cumulative_Restrictions.Set
|
||||||
|
(No_Standard_Allocators_After_Elaboration)
|
||||||
|
then
|
||||||
|
WBI ("with System.Elaboration_Allocators;");
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Generate start of package body
|
||||||
|
|
||||||
WBI ("");
|
WBI ("");
|
||||||
WBI ("package body " & Ada_Main & " is");
|
WBI ("package body " & Ada_Main & " is");
|
||||||
WBI (" pragma Warnings (Off);");
|
WBI (" pragma Warnings (Off);");
|
||||||
|
|
|
@ -801,7 +801,7 @@ package body Exp_Attr is
|
||||||
pragma Assert
|
pragma Assert
|
||||||
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
|
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
|
||||||
and then Nkind (Parent (Parent (Loop_Stmt))) =
|
and then Nkind (Parent (Parent (Loop_Stmt))) =
|
||||||
N_Block_Statement);
|
N_Block_Statement);
|
||||||
|
|
||||||
Decls := Declarations (Parent (Parent (Loop_Stmt)));
|
Decls := Declarations (Parent (Parent (Loop_Stmt)));
|
||||||
end if;
|
end if;
|
||||||
|
@ -1022,6 +1022,19 @@ package body Exp_Attr is
|
||||||
|
|
||||||
if Present (Result) then
|
if Present (Result) then
|
||||||
Rewrite (Loop_Stmt, Result);
|
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);
|
Analyze (Loop_Stmt);
|
||||||
|
|
||||||
-- The conditional block was analyzed when a previous 'Loop_Entry was
|
-- The conditional block was analyzed when a previous 'Loop_Entry was
|
||||||
|
|
|
@ -4490,6 +4490,20 @@ package body Exp_Ch4 is
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- If no storage pool has been specified and we have the restriction
|
||||||
|
-- No_Standard_Allocators_After_Elaboration is present, then generate
|
||||||
|
-- a call to Elaboration_Allocators.Check_Standard_Allocator.
|
||||||
|
|
||||||
|
if Nkind (N) = N_Allocator
|
||||||
|
and then No (Storage_Pool (N))
|
||||||
|
and then Restriction_Active (No_Standard_Allocators_After_Elaboration)
|
||||||
|
then
|
||||||
|
Insert_Action (N,
|
||||||
|
Make_Procedure_Call_Statement (Loc,
|
||||||
|
Name =>
|
||||||
|
New_Occurrence_Of (RTE (RE_Check_Standard_Allocator), Loc)));
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Handle case of qualified expression (other than optimization above)
|
-- Handle case of qualified expression (other than optimization above)
|
||||||
-- First apply constraint checks, because the bounds or discriminants
|
-- First apply constraint checks, because the bounds or discriminants
|
||||||
-- in the aggregate might not match the subtype mark in the allocator.
|
-- in the aggregate might not match the subtype mark in the allocator.
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2002-2010, AdaCore --
|
-- Copyright (C) 2002-2014, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -31,6 +31,9 @@
|
||||||
|
|
||||||
-- This is the VMS version
|
-- This is the VMS version
|
||||||
|
|
||||||
|
-- Note: there is far too much code duplication wrt g-expect.adb (the
|
||||||
|
-- standard version). This should be factored out ???
|
||||||
|
|
||||||
with System; use System;
|
with System; use System;
|
||||||
with Ada.Calendar; use Ada.Calendar;
|
with Ada.Calendar; use Ada.Calendar;
|
||||||
|
|
||||||
|
|
|
@ -3769,7 +3769,37 @@ also suppress generation of cross-reference information
|
||||||
|
|
||||||
@item ^-gnateA^/ALIASING_CHECK^
|
@item ^-gnateA^/ALIASING_CHECK^
|
||||||
@cindex @option{-gnateA} (@command{gcc})
|
@cindex @option{-gnateA} (@command{gcc})
|
||||||
Check that there is no aliasing between two parameters of the same subprogram.
|
Check that the actual parameters of a subprogram call are not aliases of one
|
||||||
|
another. To qualify as aliasing, the actuals must denote objects of a composite
|
||||||
|
type, their memory locations must be identical or overlapping, and at least one
|
||||||
|
of the corresponding formal parameters must be of mode OUT or IN OUT.
|
||||||
|
|
||||||
|
@smallexample
|
||||||
|
type Rec_Typ is record
|
||||||
|
Data : Integer := 0;
|
||||||
|
end record;
|
||||||
|
|
||||||
|
function Self (Val : Rec_Typ) return Rec_Typ is
|
||||||
|
begin
|
||||||
|
return Val;
|
||||||
|
end Self;
|
||||||
|
|
||||||
|
procedure Detect_Aliasing (Val_1 : in out Rec_Typ; Val_2 : Rec_Typ) is
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end Detect_Aliasing;
|
||||||
|
|
||||||
|
Obj : Rec_Typ;
|
||||||
|
|
||||||
|
Detect_Aliasing (Obj, Obj);
|
||||||
|
Detect_Aliasing (Obj, Self (Obj));
|
||||||
|
@end smallexample
|
||||||
|
|
||||||
|
In the example above, the first call to @code{Detect_Aliasing} fails with a
|
||||||
|
@code{Program_Error} at runtime because the actuals for @code{Val_1} and
|
||||||
|
@code{Val_2} denote the same object. The second call executes without raising
|
||||||
|
an exception because @code{Self(Obj)} produces an anonymous object which does
|
||||||
|
not share the memory location of @code{Obj}.
|
||||||
|
|
||||||
@item -gnatec=@var{path}
|
@item -gnatec=@var{path}
|
||||||
@cindex @option{-gnatec} (@command{gcc})
|
@cindex @option{-gnatec} (@command{gcc})
|
||||||
|
@ -3991,7 +4021,8 @@ support this switch.
|
||||||
|
|
||||||
@item ^-gnateV^/PARAMETER_VALIDITY_CHECK^
|
@item ^-gnateV^/PARAMETER_VALIDITY_CHECK^
|
||||||
@cindex @option{-gnateV} (@command{gcc})
|
@cindex @option{-gnateV} (@command{gcc})
|
||||||
Check validity of subprogram parameters.
|
Check that all actual parameters of a subprogram call are valid according to
|
||||||
|
the rules of validity checking (@pxref{Validity Checking}).
|
||||||
|
|
||||||
@item ^-gnateY^/IGNORE_SUPPRESS_SYLE_CHECK_PRAGMAS^
|
@item ^-gnateY^/IGNORE_SUPPRESS_SYLE_CHECK_PRAGMAS^
|
||||||
@cindex @option{-gnateY} (@command{gcc})
|
@cindex @option{-gnateY} (@command{gcc})
|
||||||
|
|
|
@ -214,7 +214,6 @@ package body Lib.Load is
|
||||||
Expected_Unit => Spec_Name,
|
Expected_Unit => Spec_Name,
|
||||||
Fatal_Error => True,
|
Fatal_Error => True,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_Allocator => False,
|
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
Ident_String => Empty,
|
Ident_String => Empty,
|
||||||
|
@ -321,7 +320,6 @@ package body Lib.Load is
|
||||||
Expected_Unit => No_Unit_Name,
|
Expected_Unit => No_Unit_Name,
|
||||||
Fatal_Error => False,
|
Fatal_Error => False,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_Allocator => False,
|
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
Ident_String => Empty,
|
Ident_String => Empty,
|
||||||
|
@ -685,7 +683,6 @@ package body Lib.Load is
|
||||||
Expected_Unit => Uname_Actual,
|
Expected_Unit => Uname_Actual,
|
||||||
Fatal_Error => False,
|
Fatal_Error => False,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_Allocator => False,
|
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
Ident_String => Empty,
|
Ident_String => Empty,
|
||||||
|
|
|
@ -82,7 +82,6 @@ package body Lib.Writ is
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Fatal_Error => False,
|
Fatal_Error => False,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_Allocator => False,
|
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
Ident_String => Empty,
|
Ident_String => Empty,
|
||||||
|
@ -140,7 +139,6 @@ package body Lib.Writ is
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Fatal_Error => False,
|
Fatal_Error => False,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_Allocator => False,
|
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
Ident_String => Empty,
|
Ident_String => Empty,
|
||||||
|
@ -1020,10 +1018,6 @@ package body Lib.Writ is
|
||||||
Write_Info_Nat (Opt.Time_Slice_Value);
|
Write_Info_Nat (Opt.Time_Slice_Value);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Has_Allocator (Main_Unit) then
|
|
||||||
Write_Info_Str (" AB");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Main_CPU (Main_Unit) /= Default_Main_CPU then
|
if Main_CPU (Main_Unit) /= Default_Main_CPU then
|
||||||
Write_Info_Str (" C=");
|
Write_Info_Str (" C=");
|
||||||
Write_Info_Nat (Main_CPU (Main_Unit));
|
Write_Info_Nat (Main_CPU (Main_Unit));
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- S p e c --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -116,7 +116,7 @@ package Lib.Writ is
|
||||||
-- -- M Main Program --
|
-- -- M Main Program --
|
||||||
-- ---------------------
|
-- ---------------------
|
||||||
|
|
||||||
-- M type [priority] [T=time-slice] [AB] [C=cpu] W=?
|
-- M type [priority] [T=time-slice] [C=cpu] W=?
|
||||||
|
|
||||||
-- This line appears only if the main unit for this file is suitable
|
-- This line appears only if the main unit for this file is suitable
|
||||||
-- for use as a main program. The parameters are:
|
-- for use as a main program. The parameters are:
|
||||||
|
@ -141,14 +141,6 @@ package Lib.Writ is
|
||||||
-- milliseconds. The actual significance of this parameter is
|
-- milliseconds. The actual significance of this parameter is
|
||||||
-- target dependent.
|
-- target dependent.
|
||||||
|
|
||||||
-- AB
|
|
||||||
|
|
||||||
-- Present if there is an allocator in the body of the procedure
|
|
||||||
-- after the BEGIN. This will be a violation of the restriction
|
|
||||||
-- No_Allocators_After_Elaboration if it is present, and this
|
|
||||||
-- unit is used as a main program (only the binder can find the
|
|
||||||
-- violation, since only the binder knows the main program).
|
|
||||||
|
|
||||||
-- C=cpu
|
-- C=cpu
|
||||||
|
|
||||||
-- Present only if there was a valid pragma CPU in the
|
-- Present only if there was a valid pragma CPU in the
|
||||||
|
|
|
@ -116,11 +116,6 @@ package body Lib is
|
||||||
return Units.Table (U).Generate_Code;
|
return Units.Table (U).Generate_Code;
|
||||||
end Generate_Code;
|
end Generate_Code;
|
||||||
|
|
||||||
function Has_Allocator (U : Unit_Number_Type) return Boolean is
|
|
||||||
begin
|
|
||||||
return Units.Table (U).Has_Allocator;
|
|
||||||
end Has_Allocator;
|
|
||||||
|
|
||||||
function Has_RACW (U : Unit_Number_Type) return Boolean is
|
function Has_RACW (U : Unit_Number_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
return Units.Table (U).Has_RACW;
|
return Units.Table (U).Has_RACW;
|
||||||
|
@ -206,11 +201,6 @@ package body Lib is
|
||||||
Units.Table (U).Generate_Code := B;
|
Units.Table (U).Generate_Code := B;
|
||||||
end Set_Generate_Code;
|
end Set_Generate_Code;
|
||||||
|
|
||||||
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True) is
|
|
||||||
begin
|
|
||||||
Units.Table (U).Has_Allocator := B;
|
|
||||||
end Set_Has_Allocator;
|
|
||||||
|
|
||||||
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is
|
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is
|
||||||
begin
|
begin
|
||||||
Units.Table (U).Has_RACW := B;
|
Units.Table (U).Has_RACW := B;
|
||||||
|
|
|
@ -316,10 +316,6 @@ package Lib is
|
||||||
-- code is to be generated. This includes the unit explicitly compiled,
|
-- code is to be generated. This includes the unit explicitly compiled,
|
||||||
-- together with its specification, and any subunits.
|
-- together with its specification, and any subunits.
|
||||||
|
|
||||||
-- Has_Allocator
|
|
||||||
-- This flag is set if a subprogram unit has an allocator after the
|
|
||||||
-- BEGIN (it is used to set the AB flag in the M ALI line).
|
|
||||||
|
|
||||||
-- Has_RACW
|
-- Has_RACW
|
||||||
-- A Boolean flag, initially set to False when a unit entry is created,
|
-- A Boolean flag, initially set to False when a unit entry is created,
|
||||||
-- and set to True if the unit defines a remote access to class wide
|
-- and set to True if the unit defines a remote access to class wide
|
||||||
|
@ -409,7 +405,6 @@ package Lib is
|
||||||
function Fatal_Error (U : Unit_Number_Type) return Boolean;
|
function Fatal_Error (U : Unit_Number_Type) return Boolean;
|
||||||
function Generate_Code (U : Unit_Number_Type) return Boolean;
|
function Generate_Code (U : Unit_Number_Type) return Boolean;
|
||||||
function Ident_String (U : Unit_Number_Type) return Node_Id;
|
function Ident_String (U : Unit_Number_Type) return Node_Id;
|
||||||
function Has_Allocator (U : Unit_Number_Type) return Boolean;
|
|
||||||
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
||||||
function Loading (U : Unit_Number_Type) return Boolean;
|
function Loading (U : Unit_Number_Type) return Boolean;
|
||||||
function Main_CPU (U : Unit_Number_Type) return Int;
|
function Main_CPU (U : Unit_Number_Type) return Int;
|
||||||
|
@ -428,7 +423,6 @@ package Lib is
|
||||||
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True);
|
|
||||||
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
||||||
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
|
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
|
||||||
|
@ -726,7 +720,6 @@ private
|
||||||
pragma Inline (Dependency_Num);
|
pragma Inline (Dependency_Num);
|
||||||
pragma Inline (Fatal_Error);
|
pragma Inline (Fatal_Error);
|
||||||
pragma Inline (Generate_Code);
|
pragma Inline (Generate_Code);
|
||||||
pragma Inline (Has_Allocator);
|
|
||||||
pragma Inline (Has_RACW);
|
pragma Inline (Has_RACW);
|
||||||
pragma Inline (Increment_Serial_Number);
|
pragma Inline (Increment_Serial_Number);
|
||||||
pragma Inline (Loading);
|
pragma Inline (Loading);
|
||||||
|
@ -738,7 +731,6 @@ private
|
||||||
pragma Inline (Set_Cunit_Entity);
|
pragma Inline (Set_Cunit_Entity);
|
||||||
pragma Inline (Set_Fatal_Error);
|
pragma Inline (Set_Fatal_Error);
|
||||||
pragma Inline (Set_Generate_Code);
|
pragma Inline (Set_Generate_Code);
|
||||||
pragma Inline (Set_Has_Allocator);
|
|
||||||
pragma Inline (Set_Has_RACW);
|
pragma Inline (Set_Has_RACW);
|
||||||
pragma Inline (Set_Loading);
|
pragma Inline (Set_Loading);
|
||||||
pragma Inline (Set_Main_CPU);
|
pragma Inline (Set_Main_CPU);
|
||||||
|
@ -770,7 +762,6 @@ private
|
||||||
Dynamic_Elab : Boolean;
|
Dynamic_Elab : Boolean;
|
||||||
Filler : Boolean;
|
Filler : Boolean;
|
||||||
Loading : Boolean;
|
Loading : Boolean;
|
||||||
Has_Allocator : Boolean;
|
|
||||||
OA_Setting : Character;
|
OA_Setting : Character;
|
||||||
SPARK_Mode_Pragma : Node_Id;
|
SPARK_Mode_Pragma : Node_Id;
|
||||||
end record;
|
end record;
|
||||||
|
@ -798,10 +789,9 @@ private
|
||||||
Generate_Code at 57 range 0 .. 7;
|
Generate_Code at 57 range 0 .. 7;
|
||||||
Has_RACW at 58 range 0 .. 7;
|
Has_RACW at 58 range 0 .. 7;
|
||||||
Dynamic_Elab at 59 range 0 .. 7;
|
Dynamic_Elab at 59 range 0 .. 7;
|
||||||
Filler at 60 range 0 .. 7;
|
Filler at 60 range 0 .. 15;
|
||||||
OA_Setting at 61 range 0 .. 7;
|
OA_Setting at 62 range 0 .. 7;
|
||||||
Loading at 62 range 0 .. 7;
|
Loading at 63 range 0 .. 7;
|
||||||
Has_Allocator at 63 range 0 .. 7;
|
|
||||||
SPARK_Mode_Pragma at 64 range 0 .. 31;
|
SPARK_Mode_Pragma at 64 range 0 .. 31;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2009-2013, Free Software Foundation, Inc. --
|
-- Copyright (C) 2009-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -357,7 +357,7 @@ package body Par_SCO is
|
||||||
|
|
||||||
function Is_Logical_Operator (N : Node_Id) return Boolean is
|
function Is_Logical_Operator (N : Node_Id) return Boolean is
|
||||||
begin
|
begin
|
||||||
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
|
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else, N_If_Expression);
|
||||||
end Is_Logical_Operator;
|
end Is_Logical_Operator;
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
|
@ -241,6 +241,7 @@ package Rtsfind is
|
||||||
System_Dim,
|
System_Dim,
|
||||||
System_DSA_Services,
|
System_DSA_Services,
|
||||||
System_DSA_Types,
|
System_DSA_Types,
|
||||||
|
System_Elaboration_Allocators,
|
||||||
System_Exception_Table,
|
System_Exception_Table,
|
||||||
System_Exceptions_Debug,
|
System_Exceptions_Debug,
|
||||||
System_Exn_Int,
|
System_Exn_Int,
|
||||||
|
@ -856,6 +857,8 @@ package Rtsfind is
|
||||||
|
|
||||||
RE_Any_Container_Ptr, -- System.DSA_Types
|
RE_Any_Container_Ptr, -- System.DSA_Types
|
||||||
|
|
||||||
|
RE_Check_Standard_Allocator, -- System.Elaboration_Allocators
|
||||||
|
|
||||||
RE_Register_Exception, -- System.Exception_Table
|
RE_Register_Exception, -- System.Exception_Table
|
||||||
|
|
||||||
RE_Local_Raise, -- System.Exceptions_Debug
|
RE_Local_Raise, -- System.Exceptions_Debug
|
||||||
|
@ -2141,6 +2144,8 @@ package Rtsfind is
|
||||||
|
|
||||||
RE_Any_Container_Ptr => System_DSA_Types,
|
RE_Any_Container_Ptr => System_DSA_Types,
|
||||||
|
|
||||||
|
RE_Check_Standard_Allocator => System_Elaboration_Allocators,
|
||||||
|
|
||||||
RE_Register_Exception => System_Exception_Table,
|
RE_Register_Exception => System_Exception_Table,
|
||||||
|
|
||||||
RE_Local_Raise => System_Exceptions_Debug,
|
RE_Local_Raise => System_Exceptions_Debug,
|
||||||
|
|
|
@ -0,0 +1,72 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- GNAT RUN-TIME COMPONENTS --
|
||||||
|
-- --
|
||||||
|
-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
|
||||||
|
-- --
|
||||||
|
-- B o d y --
|
||||||
|
-- --
|
||||||
|
-- Copyright (C) 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- --
|
||||||
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||||
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||||
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||||
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||||
|
-- --
|
||||||
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||||
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||||
|
-- version 3.1, as published by the Free Software Foundation. --
|
||||||
|
-- --
|
||||||
|
-- You should have received a copy of the GNU General Public License and --
|
||||||
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||||
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||||
|
-- <http://www.gnu.org/licenses/>. --
|
||||||
|
-- --
|
||||||
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||||
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
package body System.Elaboration_Allocators is
|
||||||
|
|
||||||
|
Elaboration_In_Progress : Boolean;
|
||||||
|
pragma Atomic (Elaboration_In_Progress);
|
||||||
|
-- Flag to show if elaboration is active. We don't attempt to initialize
|
||||||
|
-- this because we want to be sure it gets reset if we are in a multiple
|
||||||
|
-- elaboration situation of some kind. Make it atomic to prevent race
|
||||||
|
-- conditions of any kind (not clearly necessary, but harmless!)
|
||||||
|
|
||||||
|
------------------------------
|
||||||
|
-- Check_Standard_Allocator --
|
||||||
|
------------------------------
|
||||||
|
|
||||||
|
procedure Check_Standard_Allocator is
|
||||||
|
begin
|
||||||
|
if not Elaboration_In_Progress then
|
||||||
|
raise Program_Error with
|
||||||
|
"standard allocator after elaboration is complete is not allowed "
|
||||||
|
& "(No_Standard_Allocators_After_Elaboration restriction active)";
|
||||||
|
end if;
|
||||||
|
end Check_Standard_Allocator;
|
||||||
|
|
||||||
|
-----------------------------
|
||||||
|
-- Mark_End_Of_Elaboration --
|
||||||
|
-----------------------------
|
||||||
|
|
||||||
|
procedure Mark_End_Of_Elaboration is
|
||||||
|
begin
|
||||||
|
Elaboration_In_Progress := False;
|
||||||
|
end Mark_End_Of_Elaboration;
|
||||||
|
|
||||||
|
-------------------------------
|
||||||
|
-- Mark_Start_Of_Elaboration --
|
||||||
|
-------------------------------
|
||||||
|
|
||||||
|
procedure Mark_Start_Of_Elaboration is
|
||||||
|
begin
|
||||||
|
Elaboration_In_Progress := True;
|
||||||
|
end Mark_Start_Of_Elaboration;
|
||||||
|
|
||||||
|
end System.Elaboration_Allocators;
|
|
@ -0,0 +1,57 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- GNAT RUN-TIME COMPONENTS --
|
||||||
|
-- --
|
||||||
|
-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
|
||||||
|
-- --
|
||||||
|
-- S p e c --
|
||||||
|
-- --
|
||||||
|
-- Copyright (C) 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- --
|
||||||
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||||
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||||
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||||
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||||
|
-- --
|
||||||
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||||
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||||
|
-- version 3.1, as published by the Free Software Foundation. --
|
||||||
|
-- --
|
||||||
|
-- You should have received a copy of the GNU General Public License and --
|
||||||
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||||
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||||
|
-- <http://www.gnu.org/licenses/>. --
|
||||||
|
-- --
|
||||||
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||||
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- This package provides the interfaces for proper handling of restriction
|
||||||
|
-- No_Standard_Allocators_After_Elaboration. It is used only by programs
|
||||||
|
-- which use this restriction.
|
||||||
|
|
||||||
|
package System.Elaboration_Allocators is
|
||||||
|
pragma Preelaborate;
|
||||||
|
|
||||||
|
procedure Mark_Start_Of_Elaboration;
|
||||||
|
-- Called right at the start of main elaboration if the program activates
|
||||||
|
-- restriction No_Standard_Allocators_After_Elaboration. We don't want to
|
||||||
|
-- rely on the normal elaboration mechanism for marking this event, since
|
||||||
|
-- that would require us to be sure to elaborate this first, which would
|
||||||
|
-- be awkward, and it is convenient to have this package be Preelaborate.
|
||||||
|
|
||||||
|
procedure Mark_End_Of_Elaboration;
|
||||||
|
-- Called when main elaboration is complete if the program has activated
|
||||||
|
-- restriction No_Standard_Allocators_After_Elaboration. This is the point
|
||||||
|
-- beyond which any standard allocator use will violate the restriction.
|
||||||
|
|
||||||
|
procedure Check_Standard_Allocator;
|
||||||
|
-- Called as part of every allocator in a program for which the restriction
|
||||||
|
-- No_Standard_Allocators_After_Elaboration is active. This will raise an
|
||||||
|
-- exception (Program_Error with an appropriate message) if it is called
|
||||||
|
-- after the call to Mark_End_Of_Elaboration.
|
||||||
|
|
||||||
|
end System.Elaboration_Allocators;
|
|
@ -10828,7 +10828,8 @@ package body Sem_Attr is
|
||||||
-- may be a subtype (e.g. given by a slice).
|
-- may be a subtype (e.g. given by a slice).
|
||||||
|
|
||||||
-- Choices may also be identifiers with no staticness
|
-- Choices may also be identifiers with no staticness
|
||||||
-- requirements, in which case rules are unclear???
|
-- requirements, in which case they must resolve to the
|
||||||
|
-- index type.
|
||||||
|
|
||||||
declare
|
declare
|
||||||
C : Node_Id;
|
C : Node_Id;
|
||||||
|
@ -10841,14 +10842,17 @@ package body Sem_Attr is
|
||||||
Indx := First_Index (Etype (Prefix (N)));
|
Indx := First_Index (Etype (Prefix (N)));
|
||||||
|
|
||||||
if Nkind (C) /= N_Aggregate then
|
if Nkind (C) /= N_Aggregate then
|
||||||
Set_Etype (C, Etype (Indx));
|
Analyze_And_Resolve (C, Etype (Indx));
|
||||||
|
Apply_Constraint_Check (C, Etype (Indx));
|
||||||
Check_Non_Static_Context (C);
|
Check_Non_Static_Context (C);
|
||||||
|
|
||||||
else
|
else
|
||||||
C_E := First (Expressions (C));
|
C_E := First (Expressions (C));
|
||||||
while Present (C_E) loop
|
while Present (C_E) loop
|
||||||
Set_Etype (C_E, Etype (Indx));
|
Analyze_And_Resolve (C_E, Etype (Indx));
|
||||||
|
Apply_Constraint_Check (C_E, Etype (Indx));
|
||||||
Check_Non_Static_Context (C_E);
|
Check_Non_Static_Context (C_E);
|
||||||
|
|
||||||
Next (C_E);
|
Next (C_E);
|
||||||
Next_Index (Indx);
|
Next_Index (Indx);
|
||||||
end loop;
|
end loop;
|
||||||
|
|
|
@ -400,6 +400,7 @@ package body Sem_Ch4 is
|
||||||
Type_Id : Entity_Id;
|
Type_Id : Entity_Id;
|
||||||
P : Node_Id;
|
P : Node_Id;
|
||||||
C : Node_Id;
|
C : Node_Id;
|
||||||
|
Onode : Node_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Check_SPARK_Restriction ("allocator is not allowed", N);
|
Check_SPARK_Restriction ("allocator is not allowed", N);
|
||||||
|
@ -420,33 +421,40 @@ package body Sem_Ch4 is
|
||||||
P := Parent (C);
|
P := Parent (C);
|
||||||
while Present (P) loop
|
while Present (P) loop
|
||||||
|
|
||||||
-- In both cases we need a handled sequence of statements, where
|
-- For the task case we need a handled sequence of statements,
|
||||||
-- the occurrence of the allocator is within the statements.
|
-- where the occurrence of the allocator is within the statements
|
||||||
|
-- and the parent is a task body
|
||||||
|
|
||||||
if Nkind (P) = N_Handled_Sequence_Of_Statements
|
if Nkind (P) = N_Handled_Sequence_Of_Statements
|
||||||
and then Is_List_Member (C)
|
and then Is_List_Member (C)
|
||||||
and then List_Containing (C) = Statements (P)
|
and then List_Containing (C) = Statements (P)
|
||||||
then
|
then
|
||||||
|
Onode := Original_Node (Parent (P));
|
||||||
|
|
||||||
-- Check for allocator within task body, this is a definite
|
-- Check for allocator within task body, this is a definite
|
||||||
-- violation of No_Allocators_After_Elaboration we can detect
|
-- violation of No_Allocators_After_Elaboration we can detect
|
||||||
-- at compile time.
|
-- at compile time.
|
||||||
|
|
||||||
if Nkind (Original_Node (Parent (P))) = N_Task_Body then
|
if Nkind (Onode) = N_Task_Body then
|
||||||
Check_Restriction
|
Check_Restriction
|
||||||
(No_Standard_Allocators_After_Elaboration, N);
|
(No_Standard_Allocators_After_Elaboration, N);
|
||||||
exit;
|
exit;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- The other case is appearance in a subprogram body. This may
|
-- The other case is appearance in a subprogram body. This is
|
||||||
-- be a violation if this is a library level subprogram, and it
|
-- a violation if this is a library level subprogram with no
|
||||||
-- turns out to be used as the main program, but only the
|
-- parameters. Note that this is now a static error even if the
|
||||||
-- binder knows that, so just record the occurrence.
|
-- subprogram is not the main program (this is a change, in an
|
||||||
|
-- earlier version only the main program was affected, and the
|
||||||
|
-- check had to be done in the binder.
|
||||||
|
|
||||||
if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body
|
if Nkind (P) = N_Subprogram_Body
|
||||||
and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
|
and then Nkind (Parent (P)) = N_Compilation_Unit
|
||||||
then
|
and then No (Parameter_Specifications (Specification (P)))
|
||||||
Set_Has_Allocator (Current_Sem_Unit);
|
then
|
||||||
end if;
|
Check_Restriction
|
||||||
|
(No_Standard_Allocators_After_Elaboration, N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
C := P;
|
C := P;
|
||||||
|
|
|
@ -1087,9 +1087,13 @@ package body Sem_Util is
|
||||||
-- If T is non-private but its base type is private, this is the
|
-- If T is non-private but its base type is private, this is the
|
||||||
-- completion of a subtype declaration whose parent type is private
|
-- completion of a subtype declaration whose parent type is private
|
||||||
-- (see Complete_Private_Subtype in Sem_Ch3). The proper discriminants
|
-- (see Complete_Private_Subtype in Sem_Ch3). The proper discriminants
|
||||||
-- are to be found in the full view of the base.
|
-- are to be found in the full view of the base. Check that the private
|
||||||
|
-- status of T and its base differ.
|
||||||
|
|
||||||
if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then
|
if Is_Private_Type (Bas)
|
||||||
|
and then not Is_Private_Type (T)
|
||||||
|
and then Present (Full_View (Bas))
|
||||||
|
then
|
||||||
Bas := Full_View (Bas);
|
Bas := Full_View (Bas);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue