+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>
* exp_disp.adb: Minor reformatting.
s-direio$(objext) \
s-dmotpr$(objext) \
s-dsaser$(objext) \
+ s-elaall$(objext) \
s-excdeb$(objext) \
s-except$(objext) \
s-exctab$(objext) \
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Sfile => No_File,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
- Allocator_In_Body => False,
WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
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
P := P + 1;
Checkc ('=');
-- 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.
- 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;
-- Wide character encoding if main procedure. Otherwise not relevant.
-- Not set if 'M' appears in Ignore_Lines.
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Start of processing for Check_Consistent_Restrictions
begin
- -- A special test, if we have a main program, then if it has an
- -- 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
- and then ALIs.Table (ALIs.First).Main_Program /= None
- and then not No_Main_Subprogram
- and then ALIs.Table (ALIs.First).Allocator_In_Body
- then
- Cumulative_Restrictions.Violated
- (No_Standard_Allocators_After_Elaboration) := True;
- ALIs.Table (ALIs.First).Restrictions.Violated
- (No_Standard_Allocators_After_Elaboration) := True;
- end if;
+ -- We used to have a special test here:
+
+ -- A special test, if we have a main program, then if it has an
+ -- 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.
+
+ -- But we don't do that any more, because in the final version of Ada
+ -- 2012, it is statically illegal to have an allocator in a library-
+ -- level subprogram, so we don't need this bind time test any more.
+ -- If we have a main program with parameters (which GNAT allows), then
+ -- allocators in that will be caught by the run-time check.
-- Loop through all restriction violations
if Dispatching_Domains_Used then
WBI (" procedure Freeze_Dispatching_Domains;");
WBI (" pragma Import");
- WBI (" (Ada, Freeze_Dispatching_Domains, " &
- """__gnat_freeze_dispatching_domains"");");
+ WBI (" (Ada, Freeze_Dispatching_Domains, "
+ & """__gnat_freeze_dispatching_domains"");");
end if;
WBI (" begin");
WBI (" end if;");
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_Int (Main_Priority);
Set_Char (';');
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.
if Dispatching_Domains_Used then
WBI ("with System.Restrictions;");
end if;
+ -- Generate with of Ada.Exceptions if needs library finalization
+
if Needs_Library_Finalization then
WBI ("with Ada.Exceptions;");
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 ("package body " & Ada_Main & " is");
WBI (" pragma Warnings (Off);");
pragma Assert
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
and then Nkind (Parent (Parent (Loop_Stmt))) =
- N_Block_Statement);
+ N_Block_Statement);
Decls := Declarations (Parent (Parent (Loop_Stmt)));
end if;
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
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)
-- First apply constraint checks, because the bounds or discriminants
-- in the aggregate might not match the subtype mark in the allocator.
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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 Ada.Calendar; use Ada.Calendar;
@item ^-gnateA^/ALIASING_CHECK^
@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}
@cindex @option{-gnatec} (@command{gcc})
@item ^-gnateV^/PARAMETER_VALIDITY_CHECK^
@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^
@cindex @option{-gnateY} (@command{gcc})
Expected_Unit => Spec_Name,
Fatal_Error => True,
Generate_Code => False,
- Has_Allocator => False,
Has_RACW => False,
Filler => False,
Ident_String => Empty,
Expected_Unit => No_Unit_Name,
Fatal_Error => False,
Generate_Code => False,
- Has_Allocator => False,
Has_RACW => False,
Filler => False,
Ident_String => Empty,
Expected_Unit => Uname_Actual,
Fatal_Error => False,
Generate_Code => False,
- Has_Allocator => False,
Has_RACW => False,
Filler => False,
Ident_String => Empty,
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
- Has_Allocator => False,
Has_RACW => False,
Filler => False,
Ident_String => Empty,
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
- Has_Allocator => False,
Has_RACW => False,
Filler => False,
Ident_String => Empty,
Write_Info_Nat (Opt.Time_Slice_Value);
end if;
- if Has_Allocator (Main_Unit) then
- Write_Info_Str (" AB");
- end if;
-
if Main_CPU (Main_Unit) /= Default_Main_CPU then
Write_Info_Str (" C=");
Write_Info_Nat (Main_CPU (Main_Unit));
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- -- 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
-- for use as a main program. The parameters are:
-- milliseconds. The actual significance of this parameter is
-- 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
-- Present only if there was a valid pragma CPU in the
return Units.Table (U).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
begin
return Units.Table (U).Has_RACW;
Units.Table (U).Generate_Code := B;
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
begin
Units.Table (U).Has_RACW := B;
-- code is to be generated. This includes the unit explicitly compiled,
-- 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
-- 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
function Fatal_Error (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 Has_Allocator (U : Unit_Number_Type) return Boolean;
function Has_RACW (U : Unit_Number_Type) return Boolean;
function Loading (U : Unit_Number_Type) return Boolean;
function Main_CPU (U : Unit_Number_Type) return Int;
procedure Set_Fatal_Error (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_Allocator (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
pragma Inline (Dependency_Num);
pragma Inline (Fatal_Error);
pragma Inline (Generate_Code);
- pragma Inline (Has_Allocator);
pragma Inline (Has_RACW);
pragma Inline (Increment_Serial_Number);
pragma Inline (Loading);
pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Fatal_Error);
pragma Inline (Set_Generate_Code);
- pragma Inline (Set_Has_Allocator);
pragma Inline (Set_Has_RACW);
pragma Inline (Set_Loading);
pragma Inline (Set_Main_CPU);
Dynamic_Elab : Boolean;
Filler : Boolean;
Loading : Boolean;
- Has_Allocator : Boolean;
OA_Setting : Character;
SPARK_Mode_Pragma : Node_Id;
end record;
Generate_Code at 57 range 0 .. 7;
Has_RACW at 58 range 0 .. 7;
Dynamic_Elab at 59 range 0 .. 7;
- Filler at 60 range 0 .. 7;
- OA_Setting at 61 range 0 .. 7;
- Loading at 62 range 0 .. 7;
- Has_Allocator at 63 range 0 .. 7;
+ Filler at 60 range 0 .. 15;
+ OA_Setting at 62 range 0 .. 7;
+ Loading at 63 range 0 .. 7;
SPARK_Mode_Pragma at 64 range 0 .. 31;
end record;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
function Is_Logical_Operator (N : Node_Id) return Boolean is
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;
-----------------------
System_Dim,
System_DSA_Services,
System_DSA_Types,
+ System_Elaboration_Allocators,
System_Exception_Table,
System_Exceptions_Debug,
System_Exn_Int,
RE_Any_Container_Ptr, -- System.DSA_Types
+ RE_Check_Standard_Allocator, -- System.Elaboration_Allocators
+
RE_Register_Exception, -- System.Exception_Table
RE_Local_Raise, -- System.Exceptions_Debug
RE_Any_Container_Ptr => System_DSA_Types,
+ RE_Check_Standard_Allocator => System_Elaboration_Allocators,
+
RE_Register_Exception => System_Exception_Table,
RE_Local_Raise => System_Exceptions_Debug,
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- may be a subtype (e.g. given by a slice).
-- 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
C : Node_Id;
Indx := First_Index (Etype (Prefix (N)));
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);
else
C_E := First (Expressions (C));
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);
+
Next (C_E);
Next_Index (Indx);
end loop;
Type_Id : Entity_Id;
P : Node_Id;
C : Node_Id;
+ Onode : Node_Id;
begin
Check_SPARK_Restriction ("allocator is not allowed", N);
P := Parent (C);
while Present (P) loop
- -- In both cases we need a handled sequence of statements, where
- -- the occurrence of the allocator is within the statements.
+ -- For the task case we need a handled sequence of 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
and then Is_List_Member (C)
and then List_Containing (C) = Statements (P)
then
+ Onode := Original_Node (Parent (P));
+
-- Check for allocator within task body, this is a definite
-- violation of No_Allocators_After_Elaboration we can detect
-- at compile time.
- if Nkind (Original_Node (Parent (P))) = N_Task_Body then
+ if Nkind (Onode) = N_Task_Body then
Check_Restriction
(No_Standard_Allocators_After_Elaboration, N);
exit;
end if;
+ end if;
- -- The other case is appearance in a subprogram body. This may
- -- be a violation if this is a library level subprogram, and it
- -- turns out to be used as the main program, but only the
- -- binder knows that, so just record the occurrence.
+ -- The other case is appearance in a subprogram body. This is
+ -- a violation if this is a library level subprogram with no
+ -- parameters. Note that this is now a static error even if the
+ -- 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
- and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
- then
- Set_Has_Allocator (Current_Sem_Unit);
- end if;
+ if Nkind (P) = N_Subprogram_Body
+ and then Nkind (Parent (P)) = N_Compilation_Unit
+ and then No (Parameter_Specifications (Specification (P)))
+ then
+ Check_Restriction
+ (No_Standard_Allocators_After_Elaboration, N);
end if;
C := P;
-- If T is non-private but its base type is private, this is the
-- completion of a subtype declaration whose parent type is private
-- (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);
end if;
projects / thirdparty / gcc.git / commitdiff
