OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

015-02-05 Robert Dewar <dewar@adacore.com> 

* sem_ch13.adb (Add_Invariants): Don't assume invariant is
	standard Boolean.
	* sem_prag.adb (Analyze_Pragma, case Check): Don't assume
	condition is standard Boolean, it can be non-standard derived
	Boolean.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Enable_Range_Check): Disconnect attempted
	optimization for the case of range check for subscript of
	unconstrained array.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* par-ch13.adb (With_Present): New function
	(Aspect_Specifications_Present): Handle WHEN in place of WITH
	(Get_Aspect_Specifications): Comment update.
	* par.adb: Comment updates.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
	* frontend.adb (Frontend): New setting of Fatal_Error.
	* lib-load.adb (Create_Dummy_Package_Unit): New setting of
	Fatal_Error.
	(Load_Main_Source): New setting of Fatal_Error
	(Load_Unit): New setting of Fatal_Error.
	* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
	Fatal_Error.
	(Ensure_System_Dependency): New setting of Fatal_Error.
	* lib.adb (Fatal_Error): New setting of Fatal_Error
	(Set_Fatal_Error): New setting of Fatal_Error.
	* lib.ads: New definition of Fatal_Error and associated routines.
	* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
	* par-load.adb (Load): New setting of Fatal_Error.
	* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
	* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
	Fatal_Error.
	(Optional_Subunit): New setting of Fatal_Error.
	(Analyze_Proper_Body): New setting of Fatal_Error.
	(Load_Needed_Body): New setting of Fatal_Error.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): If the function being called has
	out parameters do not check for language version if the function
	comes from a predefined unit, as those are always compiled in
	Ada 2012 mode.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Process_Full_View): Verify that the full view
	of a type extension must carry an explicit limited keyword if
	the partial view does (RM 7.3 (10.1)).

From-SVN: r220446
This commit is contained in:
Arnaud Charlet 2015-02-05 12:22:39 +01:00
parent c93f201145
commit ef2c20e73c
18 changed files with 245 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
gcc/ada/ChangeLog
View File

@ -1,3 +1,60 @@
2015-02-05 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Add_Invariants): Don't assume invariant is
standard Boolean.
* sem_prag.adb (Analyze_Pragma, case Check): Don't assume
condition is standard Boolean, it can be non-standard derived
Boolean.
2015-02-05 Robert Dewar <dewar@adacore.com>
* checks.adb (Enable_Range_Check): Disconnect attempted
optimization for the case of range check for subscript of
unconstrained array.
2015-02-05 Robert Dewar <dewar@adacore.com>
* par-ch13.adb (With_Present): New function
(Aspect_Specifications_Present): Handle WHEN in place of WITH
(Get_Aspect_Specifications): Comment update.
* par.adb: Comment updates.
2015-02-05 Robert Dewar <dewar@adacore.com>
* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
* frontend.adb (Frontend): New setting of Fatal_Error.
* lib-load.adb (Create_Dummy_Package_Unit): New setting of
Fatal_Error.
(Load_Main_Source): New setting of Fatal_Error
(Load_Unit): New setting of Fatal_Error.
* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
Fatal_Error.
(Ensure_System_Dependency): New setting of Fatal_Error.
* lib.adb (Fatal_Error): New setting of Fatal_Error
(Set_Fatal_Error): New setting of Fatal_Error.
* lib.ads: New definition of Fatal_Error and associated routines.
* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
* par-load.adb (Load): New setting of Fatal_Error.
* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
Fatal_Error.
(Optional_Subunit): New setting of Fatal_Error.
(Analyze_Proper_Body): New setting of Fatal_Error.
(Load_Needed_Body): New setting of Fatal_Error.
2015-02-05 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Call): If the function being called has
out parameters do not check for language version if the function
comes from a predefined unit, as those are always compiled in
Ada 2012 mode.
2015-02-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Process_Full_View): Verify that the full view
of a type extension must carry an explicit limited keyword if
the partial view does (RM 7.3 (10.1)).
2015-02-05 Robert Dewar <dewar@adacore.com>
* g-rannum.adb, g-rannum.ads, s-rannum.adb, s-rannum.ads,

12
gcc/ada/checks.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -5521,10 +5521,14 @@ package body Checks is
return;
end if;
-- Ditto if the prefix is an explicit dereference whose designated
-- type is unconstrained.
-- Ditto if prefix is simply an unconstrained array. We used
-- to think this case was OK, if the prefix was not an explicit
-- dereference, but we have now seen a case where this is not
-- true, so it is safer to just suppress the optimization in this
-- case. The back end is getting better at eliminating redundant
-- checks in any case, so the loss won't be important.
elsif Nkind (Prefix (P)) = N_Explicit_Dereference
elsif Is_Array_Type (Atyp)
and then not Is_Constrained (Atyp)
then
Activate_Range_Check (N);

17
gcc/ada/errout.adb
View File

@ -753,12 +753,23 @@ package body Errout is
end if;
-- Set the fatal error flag in the unit table unless we are in
-- Try_Semantics mode. This stops the semantics from being performed
-- Try_Semantics mode (in which case we set ignored mode if not
-- currently set. This stops the semantics from being performed
-- if we find a serious error. This is skipped if we are currently
-- dealing with the configuration pragma file.
if not Try_Semantics and then Current_Source_Unit /= No_Unit then
Set_Fatal_Error (Get_Source_Unit (Sptr));
if Current_Source_Unit /= No_Unit then
declare
U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
begin
if Try_Semantics then
if Fatal_Error (U) = None then
Set_Fatal_Error (U, Error_Ignored);
end if;
else
Set_Fatal_Error (U, Error_Detected);
end if;
end;
end if;
end Handle_Serious_Error;

6
gcc/ada/frontend.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -338,7 +338,7 @@ begin
-- unit failed to load, to avoid cascaded inconsistencies that can lead
-- to a compiler crash.
and then not Fatal_Error (Main_Unit)
and then Fatal_Error (Main_Unit) /= Error_Detected
then
-- Pragmas that require some semantic activity, such as Interrupt_State,
-- cannot be processed until the main unit is installed, because they
@ -388,7 +388,7 @@ begin
-- Following steps are skipped if we had a fatal error during parsing
if not Fatal_Error (Main_Unit) then
if Fatal_Error (Main_Unit) /= Error_Detected then
-- Reset Operating_Mode to Check_Semantics for subunits. We cannot
-- actually generate code for subunits, so we suppress expansion.

26
gcc/ada/lib-load.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -212,7 +212,7 @@ package body Lib.Load is
Dynamic_Elab => False,
Error_Location => Sloc (With_Node),
Expected_Unit => Spec_Name,
Fatal_Error => True,
Fatal_Error => Error_Detected,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@ -319,7 +319,7 @@ package body Lib.Load is
Dynamic_Elab => False,
Error_Location => No_Location,
Expected_Unit => No_Unit_Name,
Fatal_Error => False,
Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@ -683,7 +683,7 @@ package body Lib.Load is
Dynamic_Elab => False,
Error_Location => Sloc (Error_Node),
Expected_Unit => Uname_Actual,
Fatal_Error => False,
Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@ -742,10 +742,20 @@ package body Lib.Load is
-- If loaded unit had a fatal error, then caller inherits it
if Units.Table (Unum).Fatal_Error
and then Present (Error_Node)
then
Units.Table (Calling_Unit).Fatal_Error := True;
if Present (Error_Node) then
case Units.Table (Unum).Fatal_Error is
when None =>
null;
when Error_Detected =>
Units.Table (Calling_Unit).Fatal_Error := Error_Detected;
when Error_Ignored =>
if Units.Table (Calling_Unit).Fatal_Error = None then
Units.Table (Calling_Unit).Fatal_Error :=
Error_Ignored;
end if;
end case;
end if;
-- Remove load stack entry and return the entry in the file table

4
gcc/ada/lib-writ.adb
View File

@ -81,7 +81,7 @@ package body Lib.Writ is
Cunit_Entity => Empty,
Dependency_Num => 0,
Dynamic_Elab => False,
Fatal_Error => False,
Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@ -139,7 +139,7 @@ package body Lib.Writ is
Cunit_Entity => Empty,
Dependency_Num => 0,
Dynamic_Elab => False,
Fatal_Error => False,
Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,

8
gcc/ada/lib.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -106,7 +106,7 @@ package body Lib is
return Units.Table (U).Expected_Unit;
end Expected_Unit;
function Fatal_Error (U : Unit_Number_Type) return Boolean is
function Fatal_Error (U : Unit_Number_Type) return Fatal_Type is
begin
return Units.Table (U).Fatal_Error;
end Fatal_Error;
@ -196,9 +196,9 @@ package body Lib is
Units.Table (U).Error_Location := W;
end Set_Error_Location;
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True) is
procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type) is
begin
Units.Table (U).Fatal_Error := B;
Units.Table (U).Fatal_Error := V;
end Set_Fatal_Error;
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is

55
gcc/ada/lib.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -302,7 +302,7 @@ package Lib is
-- No_Name for the main unit.
-- Fatal_Error
-- A flag that is initialized to False, and gets set to True if a fatal
-- A flag that is initialized to None and gets set to Errorif a fatal
-- error occurs during the processing of a unit. A fatal error is one
-- defined as serious enough to stop the next phase of the compiler
-- from running (i.e. fatal error during parsing stops semantics,
@ -310,6 +310,7 @@ package Lib is
-- currently, errors of any kind cause Fatal_Error to be set, but
-- eventually perhaps only errors labeled as fatal errors should be
-- this severe if we decide to try Sem on sources with minor errors.
-- There are three settings (see declaration of Fatal_Type).
-- Generate_Code
-- This flag is set True for all units in the current file for which
@ -401,13 +402,29 @@ package Lib is
Default_Main_CPU : constant Int := -1;
-- Value used in Main_CPU field to indicate default main affinity
-- The following defines settings for the Fatal_Error field
type Fatal_Type is (
None,
-- No error detected for this unit
Error_Detected,
-- Fatal error detected that prevents moving to the next phase. For
-- example, a fatal error during parsing inhibits semantic analysis.
Error_Ignored);
-- A fatal error was detected, but we are in Try_Semantics mode (as set
-- by -gnatq or -gnatQ). This does not stop the compiler from proceding,
-- but tools can use this status (e.g. ASIS looking at the generated
-- tree) to know that a fatal error was detected.
function Cunit (U : Unit_Number_Type) return Node_Id;
function Cunit_Entity (U : Unit_Number_Type) return Entity_Id;
function Dependency_Num (U : Unit_Number_Type) return Nat;
function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
function Error_Location (U : Unit_Number_Type) return Source_Ptr;
function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type;
function Fatal_Error (U : Unit_Number_Type) return Boolean;
function Fatal_Error (U : Unit_Number_Type) return Fatal_Type;
function Generate_Code (U : Unit_Number_Type) return Boolean;
function Ident_String (U : Unit_Number_Type) return Node_Id;
function Has_RACW (U : Unit_Number_Type) return Boolean;
@ -422,20 +439,20 @@ package Lib is
function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
-- Get value of named field from given units table entry
procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
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_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);
procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type);
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Has_RACW (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);
procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
-- Set value of named field for given units table entry. Note that we
-- do not have an entry for each possible field, since some of the fields
-- can only be set by specialized interfaces (defined below).
@ -606,7 +623,7 @@ package Lib is
function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
-- Determines if unit with given name is already loaded, i.e. there is
-- already an entry in the file table with this unit name for which the
-- corresponding file was found and parsed. Note that the Fatal_Error flag
-- corresponding file was found and parsed. Note that the Fatal_Error value
-- of this entry must be checked before proceeding with further processing.
function Last_Unit return Unit_Number_Type;
@ -767,7 +784,7 @@ private
Serial_Number : Nat;
Version : Word;
Error_Location : Source_Ptr;
Fatal_Error : Boolean;
Fatal_Error : Fatal_Type;
Generate_Code : Boolean;
Has_RACW : Boolean;
Dynamic_Elab : Boolean;

8
gcc/ada/par-ch10.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -596,7 +596,7 @@ package body Ch10 is
else
Cunit_Error_Flag := True;
Set_Fatal_Error (Current_Source_Unit);
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
end if;
-- Clear away any missing semicolon indication, we are done with that
@ -726,7 +726,7 @@ package body Ch10 is
-- cascaded messages in some situations.
else
if not Fatal_Error (Current_Source_Unit) then
if Fatal_Error (Current_Source_Unit) /= Error_Detected then
if Token in Token_Class_Cunit then
Error_Msg_SC
("end of file expected, " &
@ -758,7 +758,7 @@ package body Ch10 is
-- An error resync is a serious bomb, so indicate result unit no good
when Error_Resync =>
Set_Fatal_Error (Current_Source_Unit);
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
return Error;
end P_Compilation_Unit;

52
gcc/ada/par-ch13.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -48,6 +48,10 @@ package body Ch13 is
function Possible_Misspelled_Aspect return Boolean;
-- Returns True, if Token_Name is a misspelling of some aspect name
function With_Present return Boolean;
-- Returns True if WITH is present, indicating presence of aspect
-- specifications. Also allows incorrect use of WHEN in place of WITH.
--------------------------------
-- Possible_Misspelled_Aspect --
--------------------------------
@ -63,6 +67,43 @@ package body Ch13 is
return False;
end Possible_Misspelled_Aspect;
------------------
-- With_Present --
------------------
function With_Present return Boolean is
begin
if Token = Tok_With then
return True;
-- Check for WHEN used in place of WITH
elsif Token = Tok_When then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past WHEN
if Token = Tok_Identifier
and then Get_Aspect_Id (Token_Name) /= No_Aspect
then
Error_Msg_SC ("WHEN should be WITH");
Restore_Scan_State (Scan_State);
return True;
else
Restore_Scan_State (Scan_State);
return False;
end if;
end;
else
return False;
end if;
end With_Present;
-- Start of processing for Aspect_Specifications_Present
begin
@ -79,14 +120,15 @@ package body Ch13 is
-- be too expensive. Instead we pick up the aspect specifications later
-- as a bogus declaration, and diagnose the semicolon at that point.
if Token /= Tok_With then
if not With_Present then
return False;
end if;
-- Have a WITH, see if it looks like an aspect specification
-- Have a WITH or some token that we accept as a legitimate bad attempt
-- at writing WITH. See if it looks like an aspect specification
Save_Scan_State (Scan_State);
Scan; -- past WITH
Scan; -- past WITH (or WHEN or other bad keyword)
-- If no identifier, then consider that we definitely do not have an
-- aspect specification.
@ -193,7 +235,7 @@ package body Ch13 is
return Aspects;
end if;
Scan; -- past WITH
Scan; -- past WITH (or possible WHEN after error)
Aspects := Empty_List;
-- Loop to scan aspects

4
gcc/ada/par-load.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -127,7 +127,7 @@ procedure Load is
begin
-- Don't do any loads if we already had a fatal error
if Fatal_Error (Cur_Unum) then
if Fatal_Error (Cur_Unum) = Error_Detected then
return;
end if;

25
gcc/ada/par.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -951,6 +951,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- permitted). Note: this routine never checks the terminator token
-- for aspects so it does not matter whether the aspect specifications
-- are terminated by semicolon or some other character.
--
-- Note: This function also handles the case of WHEN used where WITH
-- was intended, and in that case posts an error and returns True.
procedure P_Aspect_Specifications
(Decl : Node_Id;
@ -960,15 +963,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- argument is False, the scan pointer is left pointing past the aspects
-- and the caller must check for a proper terminator.
--
-- P_Aspect_Specifications is called with the current token pointing to
-- either a WITH keyword starting an aspect specification, or an
-- instance of the terminator token. In the former case, the aspect
-- specifications are scanned out including the terminator token if it
-- it is a semicolon, and the Has_Aspect_Specifications flag is set in
-- the given declaration node. A list of aspects is built and stored for
-- this declaration node using a call to Set_Aspect_Specifications. If
-- no WITH keyword is present, then this call has no effect other than
-- scanning out the terminator if it is a semicolon.
-- P_Aspect_Specifications is called with the current token pointing
-- to either a WITH keyword starting an aspect specification, or an
-- instance of what shpould be a terminator token. In the former case,
-- the aspect specifications are scanned out including the terminator
-- token if it it is a semicolon, and the Has_Aspect_Specifications
-- flag is set in the given declaration node. A list of aspects
-- is built and stored for this declaration node using a call to
-- Set_Aspect_Specifications. If no WITH keyword is present, then this
-- call has no effect other than scanning out the terminator if it is a
-- semicolon (with the exception that it detects WHEN used in place of
-- WITH).
-- If Decl is Error on entry, any scanned aspect specifications are
-- ignored and a message is output saying aspect specifications not

6
gcc/ada/rtsfind.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -979,7 +979,7 @@ package body Rtsfind is
if U.Unum = No_Unit then
Load_Fail ("not found", U_Id, Id);
elsif Fatal_Error (U.Unum) then
elsif Fatal_Error (U.Unum) = Error_Detected then
Load_Fail ("had parser errors", U_Id, Id);
end if;
@ -1025,7 +1025,7 @@ package body Rtsfind is
Semantics (Cunit (U.Unum));
Restore_Private_Visibility;
if Fatal_Error (U.Unum) then
if Fatal_Error (U.Unum) = Error_Detected then
Load_Fail ("had semantic errors", U_Id, Id);
end if;
end if;

15
gcc/ada/sem_ch10.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -936,7 +936,7 @@ package body Sem_Ch10 is
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
or else
Distribution_Stub_Mode = Generate_Caller_Stub_Body)
and then not Fatal_Error (Main_Unit)
and then Fatal_Error (Main_Unit) /= Error_Detected
then
if Is_RCI_Pkg_Spec_Or_Body (N) then
@ -1096,7 +1096,7 @@ package body Sem_Ch10 is
elsif not Analyzed (Cunit (Un))
and then Un /= Main_Unit
and then not Fatal_Error (Un)
and then Fatal_Error (Un) /= Error_Detected
then
Style_Check := False;
Semantics (Cunit (Un));
@ -1623,7 +1623,8 @@ package body Sem_Ch10 is
-- All done if we successfully loaded the subunit
if Unum /= No_Unit
and then (not Fatal_Error (Unum) or else Try_Semantics)
and then (Fatal_Error (Unum) /= Error_Detected
or else Try_Semantics)
then
Comp_Unit := Cunit (Unum);
@ -1860,7 +1861,9 @@ package body Sem_Ch10 is
-- Analyze the unit if semantics active
if not Fatal_Error (Unum) or else Try_Semantics then
if Fatal_Error (Unum) /= Error_Detected
or else Try_Semantics
then
Analyze_Subunit (Comp_Unit);
end if;
end if;
@ -5442,7 +5445,7 @@ package body Sem_Ch10 is
else
Compiler_State := Analyzing; -- reset after load
if not Fatal_Error (Unum) or else Try_Semantics then
if Fatal_Error (Unum) /= Error_Detected or else Try_Semantics then
if Debug_Flag_L then
Write_Str ("*** Loaded generic body");
Write_Eol;

2
gcc/ada/sem_ch13.adb
View File

@ -7770,7 +7770,7 @@ package body Sem_Ch13 is
-- at the end of the private part and has the wrong visibility.
Set_Parent (Exp, N);
Preanalyze_Assert_Expression (Exp, Standard_Boolean);
Preanalyze_Assert_Expression (Exp, Any_Boolean);
-- A class-wide invariant may be inherited in a separate unit,
-- where the corresponding expression cannot be resolved by

22
gcc/ada/sem_ch3.adb
View File

@ -19420,15 +19420,27 @@ package body Sem_Ch3 is
begin
if Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
and then not Limited_Present (Parent (Priv_T))
and then not Synchronized_Present (Parent (Priv_T))
and then Nkind (Orig_Decl) = N_Full_Type_Declaration
and then Nkind
(Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
and then Limited_Present (Type_Definition (Orig_Decl))
then
Error_Msg_N
("full view of non-limited extension cannot be limited", N);
if not Limited_Present (Parent (Priv_T))
and then not Synchronized_Present (Parent (Priv_T))
and then Limited_Present (Type_Definition (Orig_Decl))
then
Error_Msg_N
("full view of non-limited extension cannot be limited", N);
-- Conversely, if the partial view carries the limited keyword,
-- the full view must as well, even if it may be redundant.
elsif Limited_Present (Parent (Priv_T))
and then not Limited_Present (Type_Definition (Orig_Decl))
then
Error_Msg_N
("full view of limited extension must be explicitly limited",
N);
end if;
end if;
end;

2
gcc/ada/sem_prag.adb
View File

@ -11783,7 +11783,7 @@ package body Sem_Prag is
Make_If_Statement (Eloc,
Condition =>
Make_And_Then (Eloc,
Left_Opnd => New_Occurrence_Of (Standard_False, Eloc),
Left_Opnd => Make_Identifier (Eloc, Name_False),
Right_Opnd => Expr),
Then_Statements => New_List (
Make_Null_Statement (Eloc))));

5
gcc/ada/sem_res.adb
View File

@ -6310,11 +6310,14 @@ package body Sem_Res is
-- Check for calling a function with OUT or IN OUT parameter when the
-- calling context (us right now) is not Ada 2012, so does not allow
-- OUT or IN OUT parameters in function calls.
-- OUT or IN OUT parameters in function calls. Functions declared in
-- a predefined unit are OK, as they may be called indirectly from a
-- user-declared instantiation.
if Ada_Version < Ada_2012
and then Ekind (Nam) = E_Function
and then Has_Out_Or_In_Out_Parameter (Nam)
and then not In_Predefined_Unit (Nam)
then
Error_Msg_NE ("& has at least one OUT or `IN OUT` parameter", N, Nam);
Error_Msg_N ("\call to this function only allowed in Ada 2012", N);