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

[multiple changes]

Browse Source 
2012-06-14  Vincent Pucci  <pucci@adacore.com>

	* exp_ch6.adb (Expand_Call): Expand_Put_Call_With_Dimension_Symbol
	call replaced by Expand_Put_Call_With_Symbol call.
	* sem_dim.adb: New fields Unit_Names, Unit_Symbols
	and Dim_Symbols for record type System_Type.
	(From_Dimension_To_String_Of_Symbols): Removed.
	(From_Dim_To_Str_Of_Dim_Symbols): Renames previous
	routine From_Dimension_To_String_Of_Symbols.
	(From_Dim_To_Str_Of_Unit_Symbols): New routine.
	(Analyze_Aspect_Dimension): argument Symbol in aspect
	Dimension aggregate is optional. Named association implemented.
	(Has_Compile_Time_Known_Expressions): Removed.
	(Analyze_Aspect_Dimension_System): New
	component Dim_Symbol in each Dimension aggregate in
	aspect Dimension_System. Named associations implemented.
	(Add_Dimension_Vector_To_Buffer): Removed.
	(Add_Whole_To_Buffer): Removed.
	(Expand_Put_Call_With_Dimension_Symbol.): Removed.
	(Expand_Put_Call_With_Symbol): Renames previous routine
	Expand_Put_Call_With_Dimension_Symbol.
	(Has_Dimension_Symbols): Removed.
	(Has_Symbols): Renames previous routine
	Has_Dimension_Symbols.	(Store_String_Oexpon): New routine.
	* sem_dim.ads (Expand_Put_Call_With_Dimension_Symbol.): Removed.
	(Expand_Put_Call_With_Symbol): Renames previous routine
	Expand_Put_Call_With_Dimension_Symbol.
	* s-diflio.adb, s-diinio.adb (Put): Symbol renames Symbols.
	(Put_Dim_Of): New routines.
	* s-diflio.ads, s-diinio.ads: documentation updated.
	(Put): Symbol renames Symbols.
	(Put_Dim_Of): New routines.
	* s-dim.ads: documentation updated.
	* s-dimmks.ads: dimensioned type and subtypes updated.
	* snames.ads-tmpl: Name_Dim_Symbol, Name_Put_Dim_Of, Name_Symbol,
	and Name_Unit_Symbol added. Name_Symbols removed.

2012-06-14  Vincent Pucci  <pucci@adacore.com>

	* freeze.adb (In_Exp_Body): Expression function case added.
	(Freeze_Expression): Insert the Freeze_Nodes
	list before the correct current scope in case of a quantified
	expression.

2012-06-14  Pascal Obry  <obry@adacore.com>

	* projects.texi: Document the Install package for gprinstall.
2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_For_Eliminated_Subprogram): Do not check within
	a default expression.
	* sem_res.adb (Resolve_Call): simplify code.

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb (Check, Issue_Msg): within an instance, non-other
	values in a variant part or a case expression do not have to
	belong to the actual subtype.

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validate_Derived_Type_Instance): If parent is
	an interface type, check whether it is itself a previous formal
	already instantiated in the current list of actuals.

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): The
	expression for a stream attribute is a name that may be overloaded
	with other declarations. To determine whether it matches the
	aspect at the freeze point, it is necessary to verify that one
	of its interpretations matches.

From-SVN: r188610
This commit is contained in:
Arnaud Charlet 2012-06-14 12:56:22 +02:00
parent 2a290fec3d
commit df37814854
18 changed files with 1124 additions and 535 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
gcc/ada/ChangeLog
View File

@ -1,3 +1,76 @@
2012-06-14 Vincent Pucci <pucci@adacore.com>
* exp_ch6.adb (Expand_Call): Expand_Put_Call_With_Dimension_Symbol
call replaced by Expand_Put_Call_With_Symbol call.
* sem_dim.adb: New fields Unit_Names, Unit_Symbols
and Dim_Symbols for record type System_Type.
(From_Dimension_To_String_Of_Symbols): Removed.
(From_Dim_To_Str_Of_Dim_Symbols): Renames previous
routine From_Dimension_To_String_Of_Symbols.
(From_Dim_To_Str_Of_Unit_Symbols): New routine.
(Analyze_Aspect_Dimension): argument Symbol in aspect
Dimension aggregate is optional. Named association implemented.
(Has_Compile_Time_Known_Expressions): Removed.
(Analyze_Aspect_Dimension_System): New
component Dim_Symbol in each Dimension aggregate in
aspect Dimension_System. Named associations implemented.
(Add_Dimension_Vector_To_Buffer): Removed.
(Add_Whole_To_Buffer): Removed.
(Expand_Put_Call_With_Dimension_Symbol.): Removed.
(Expand_Put_Call_With_Symbol): Renames previous routine
Expand_Put_Call_With_Dimension_Symbol.
(Has_Dimension_Symbols): Removed.
(Has_Symbols): Renames previous routine
Has_Dimension_Symbols. (Store_String_Oexpon): New routine.
* sem_dim.ads (Expand_Put_Call_With_Dimension_Symbol.): Removed.
(Expand_Put_Call_With_Symbol): Renames previous routine
Expand_Put_Call_With_Dimension_Symbol.
* s-diflio.adb, s-diinio.adb (Put): Symbol renames Symbols.
(Put_Dim_Of): New routines.
* s-diflio.ads, s-diinio.ads: documentation updated.
(Put): Symbol renames Symbols.
(Put_Dim_Of): New routines.
* s-dim.ads: documentation updated.
* s-dimmks.ads: dimensioned type and subtypes updated.
* snames.ads-tmpl: Name_Dim_Symbol, Name_Put_Dim_Of, Name_Symbol,
and Name_Unit_Symbol added. Name_Symbols removed.
2012-06-14 Vincent Pucci <pucci@adacore.com>
* freeze.adb (In_Exp_Body): Expression function case added.
(Freeze_Expression): Insert the Freeze_Nodes
list before the correct current scope in case of a quantified
expression.
2012-06-14 Pascal Obry <obry@adacore.com>
* projects.texi: Document the Install package for gprinstall.
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_For_Eliminated_Subprogram): Do not check within
a default expression.
* sem_res.adb (Resolve_Call): simplify code.
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_case.adb (Check, Issue_Msg): within an instance, non-other
values in a variant part or a case expression do not have to
belong to the actual subtype.
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Validate_Derived_Type_Instance): If parent is
an interface type, check whether it is itself a previous formal
already instantiated in the current list of actuals.
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): The
expression for a stream attribute is a name that may be overloaded
with other declarations. To determine whether it matches the
aspect at the freeze point, it is necessary to verify that one
of its interpretations matches.
2012-06-14 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, exp_util.adb, sem_aux.ads, exp_ch9.adb,

2
gcc/ada/exp_ch6.adb
View File

@ -2389,7 +2389,7 @@ package body Exp_Ch6 is
and then Nkind (Call_Node) = N_Procedure_Call_Statement
and then Present (Parameter_Associations (Call_Node))
then
Expand_Put_Call_With_Dimension_Symbol (Call_Node);
Expand_Put_Call_With_Symbol (Call_Node);
end if;
-- Remove the dimensions of every parameters in call

31
gcc/ada/freeze.adb
View File

@ -4698,13 +4698,15 @@ package body Freeze is
Id := Defining_Unit_Name (Specification (P));
if Nkind (Id) = N_Defining_Identifier
and then (Is_Init_Proc (Id) or else
Is_TSS (Id, TSS_Stream_Input) or else
Is_TSS (Id, TSS_Stream_Output) or else
Is_TSS (Id, TSS_Stream_Read) or else
Is_TSS (Id, TSS_Stream_Write) or else
and then (Is_Init_Proc (Id) or else
Is_TSS (Id, TSS_Stream_Input) or else
Is_TSS (Id, TSS_Stream_Output) or else
Is_TSS (Id, TSS_Stream_Read) or else
Is_TSS (Id, TSS_Stream_Write) or else
Nkind (Original_Node (P)) =
N_Subprogram_Renaming_Declaration)
N_Subprogram_Renaming_Declaration or else
Nkind (Original_Node (P)) =
N_Expression_Function)
then
return True;
else
@ -5091,9 +5093,9 @@ package body Freeze is
or else Ekind (Current_Scope) = E_Void
then
declare
N : constant Node_Id := Current_Scope;
Freeze_Nodes : List_Id := No_List;
Pos : Int := Scope_Stack.Last;
N : constant Node_Id := Current_Scope;
Freeze_Nodes : List_Id := No_List;
Pos : Int := Scope_Stack.Last;
begin
if Present (Desig_Typ) then
@ -5109,13 +5111,18 @@ package body Freeze is
end if;
-- The current scope may be that of a constrained component of
-- an enclosing record declaration, which is above the current
-- scope in the scope stack.
-- an enclosing record declaration, or of a loop of an enclosing
-- quantified expression, which is above the current scope in the
-- scope stack. Indeed in the context of a quantified expression,
-- a scope is created and pushed above the current scope in order
-- to emulate the loop-like behavior of the quantified expression.
-- If the expression is within a top-level pragma, as for a pre-
-- condition on a library-level subprogram, nothing to do.
if not Is_Compilation_Unit (Current_Scope)
and then Is_Record_Type (Scope (Current_Scope))
and then (Is_Record_Type (Scope (Current_Scope))
or else Nkind (Parent (Current_Scope)) =
N_Quantified_Expression)
then
Pos := Pos - 1;
end if;

52
gcc/ada/projects.texi
View File

@ -226,6 +226,7 @@ should contain the following code:
* Executable File Names::
* Avoid Duplication With Variables::
* Naming Schemes::
* Installation::
@end menu
@c ---------------------------------------------
@ -1023,6 +1024,54 @@ For example, the following package models the DEC Ada file naming rules:
names in lower case)
@end ifset
@c ---------------------------------------------
@node Installation
@subsection Installation
@c ---------------------------------------------
@noindent
After building an application or a library it is often required to
install it into the development environment. This installation is
required if the library is to be used by another application for
example. The @code{gprinstall} tool provide an easy way to install
libraries, executable or object code generated durting the build. The
@b{Install} package can be used to change the default locations.
The following attributes can be defined in package @code{Install}:
@table @asis
@item @b{Active}
Whether the project is to be installed, values are @code{true}
(default) or @code{false}.
@item @b{Prefix}:
@cindex @code{Prefix}
Root directory for the installation.
@item @b{Exec_Subdir}
Subdirectory of @b{Prefix} where executables are to be
installed. Default is @b{bin}.
@item @b{Lib_Subdir}
Subdirectory of @b{Prefix} where directory with the library or object
files is to be installed. Default is @b{lib}.
@item @b{Sources_Subdir}
Subdirectory of @b{Prefix} where directory with sources is to be
installed. Default is @b{include}.
@item @b{Project_Subdir}
Subdirectory of @b{Prefix} where the installed project is to be
installed. Default is @b{share/gpr}.
@end table
@c ---------------------------------------------
@node Organizing Projects into Subsystems
@section Organizing Projects into Subsystems
@ -3039,6 +3088,9 @@ The following packages are currently supported in project files
This package specifies the options used when starting an integrated
development environment, for instance @command{GPS} or @command{Gnatbench}.
@xref{The Development Environments}.
@item Install
This package specifies the options used when installing a project
with @command{gprinstall}. @xref{Installation}.
@item Linker
This package specifies the options used by the linker.
@xref{Main Subprograms}.

70
gcc/ada/s-diflio.adb
View File

@ -38,40 +38,72 @@ package body System.Dim.Float_IO is
---------
procedure Put
(File : File_Type;
Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "")
(File : File_Type;
Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "")
is
begin
Num_Dim_Float_IO.Put (File, Item, Fore, Aft, Exp);
Ada.Text_IO.Put (File, Symbols);
Ada.Text_IO.Put (File, Symbol);
end Put;
procedure Put
(Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "")
(Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "")
is
begin
Num_Dim_Float_IO.Put (Item, Fore, Aft, Exp);
Ada.Text_IO.Put (Symbols);
Ada.Text_IO.Put (Symbol);
end Put;
procedure Put
(To : out String;
Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "")
(To : out String;
Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "")
is
begin
Num_Dim_Float_IO.Put (To, Item, Aft, Exp);
To := To & Symbols;
To := To & Symbol;
end Put;
----------------
-- Put_Dim_Of --
----------------
pragma Warnings (Off);
-- kill warnings on unreferenced formals
procedure Put_Dim_Of
(File : File_Type;
Item : Num_Dim_Float;
Symbol : String := "")
is
begin
Ada.Text_IO.Put (File, Symbol);
end Put_Dim_Of;
procedure Put_Dim_Of
(Item : Num_Dim_Float;
Symbol : String := "")
is
begin
Ada.Text_IO.Put (Symbol);
end Put_Dim_Of;
procedure Put_Dim_Of
(To : out String;
Item : Num_Dim_Float;
Symbol : String := "")
is
begin
To := Symbol;
end Put_Dim_Of;
end System.Dim.Float_IO;

121
gcc/ada/s-diflio.ads
View File

@ -31,33 +31,63 @@
-- This package provides output routines for float dimensioned types. All Put
-- routines are modelled after those in package Ada.Text_IO.Float_IO with the
-- addition of an extra default parameter.
-- addition of an extra default parameter. All Put_Dim_Of routines
-- output the dimension of Item in a symbolic manner.
-- Parameter Symbol may be used in the following manner (all the examples are
-- based on the MKS system of units as defined in package System.Dim.Mks):
-- based on the MKS system of units defined in package System.Dim.Mks):
-- type Mks_Type is new Long_Long_Float
-- with
-- Dimension_System => (
-- (Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
-- (Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
-- (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
-- (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
-- (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Θ"),
-- (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
-- (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
-- Case 1. A value is supplied for Symbol
-- The string appears as a suffix of Item
-- * Put : The string appears as a suffix of Item
-- * Put_Dim_Of : The string appears alone
-- Obj : Mks_Type := 2.6;
-- Put (Obj, 1, 1, 0, " dimensionless");
-- Put_Dim_Of (Obj, "dimensionless");
-- The corresponding output is: 2.6 dimensionless
-- The corresponding outputs are:
-- $2.6 dimensionless
-- $dimensionless
-- Case 2. No value is supplied for Symbol and Item is dimensionless
-- Item appears without a suffix
-- * Put : Item appears without a suffix
-- * Put_Dim_Of : the output is []
-- Obj : Mks_Type := 2.6;
-- Put (Obj, 1, 1, 0);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 2.6
-- The corresponding outputs are:
-- $2.6
-- $[]
-- Case 3. No value is supplied for Symbol and Item has a dimension
-- If the type of Item is a dimensioned subtype whose symbolic name is not
-- empty, then the symbolic name appears as a suffix.
-- * Put : If the type of Item is a dimensioned subtype whose
-- symbol is not empty, then the symbol appears as a suffix.
-- Otherwise, a new string is created and appears as a
-- suffix of Item. This string results in the successive
-- concatenations between each unit symbol raised by its
-- corresponding dimension power from the dimensions of Item.
-- * Put_Dim_Of : The output is a new string resulting in the successive
-- concatenations between each dimension symbol raised by its
-- corresponding dimension power from the dimensions of Item.
-- subtype Length is Mks_Type
-- with
@ -67,29 +97,33 @@
-- Obj : Length := 2.3 * dm;
-- Put (Obj, 1, 2, 0);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 0.23 m
-- Otherwise, a new string is created and appears as a suffix of Item.
-- This string results in the successive concatanations between each
-- dimension symbolic name raised by its corresponding dimension power from
-- the dimensions of Item.
-- The corresponding outputs are:
-- $0.23 m
-- $[L]
-- subtype Random is Mks_Type
-- with
-- Dimension => ("",
-- Meter => 3,
-- Candela => -1,
-- others => 0);
-- Dimension => (
-- Meter => 3,
-- Candela => -1,
-- others => 0);
-- Obj : Random := 5.0;
-- Put (Obj);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 5.0 m**3.cd**(-1)
-- The corresponding outputs are:
-- $5.0 m**3.cd**(-1)
-- $[l**3.J**(-1)]
-- Put (3.3 * km * dm * min, 5, 1, 0);
-- Put_Dim_Of (3.3 * km * dm * min);
-- The corresponding output is: 19800.0 m**2.s
-- The corresponding outputs are:
-- $19800.0 m**2.s
-- $[L**2.T]
with Ada.Text_IO; use Ada.Text_IO;
@ -103,27 +137,42 @@ package System.Dim.Float_IO is
Default_Exp : Field := 3;
procedure Put
(File : File_Type;
Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "");
(File : File_Type;
Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "");
procedure Put
(Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "");
(Item : Num_Dim_Float;
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "");
procedure Put
(To : out String;
Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "");
(To : out String;
Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "");
procedure Put_Dim_Of
(File : File_Type;
Item : Num_Dim_Float;
Symbol : String := "");
procedure Put_Dim_Of
(Item : Num_Dim_Float;
Symbol : String := "");
procedure Put_Dim_Of
(To : out String;
Item : Num_Dim_Float;
Symbol : String := "");
pragma Inline (Put);
pragma Inline (Put_Dim_Of);
end System.Dim.Float_IO;

64
gcc/ada/s-diinio.adb
View File

@ -38,40 +38,72 @@ package body System.Dim.Integer_IO is
---------
procedure Put
(File : File_Type;
Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbols : String := "")
(File : File_Type;
Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbol : String := "")
is
begin
Num_Dim_Integer_IO.Put (File, Item, Width, Base);
Ada.Text_IO.Put (File, Symbols);
Ada.Text_IO.Put (File, Symbol);
end Put;
procedure Put
(Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbols : String := "")
(Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbol : String := "")
is
begin
Num_Dim_Integer_IO.Put (Item, Width, Base);
Ada.Text_IO.Put (Symbols);
Ada.Text_IO.Put (Symbol);
end Put;
procedure Put
(To : out String;
Item : Num_Dim_Integer;
Base : Number_Base := Default_Base;
Symbols : String := "")
(To : out String;
Item : Num_Dim_Integer;
Base : Number_Base := Default_Base;
Symbol : String := "")
is
begin
Num_Dim_Integer_IO.Put (To, Item, Base);
To := To & Symbols;
To := To & Symbol;
end Put;
----------------
-- Put_Dim_Of --
----------------
pragma Warnings (Off);
-- kill warnings on unreferenced formals
procedure Put_Dim_Of
(File : File_Type;
Item : Num_Dim_Integer;
Symbol : String := "")
is
begin
Ada.Text_IO.Put (File, Symbol);
end Put_Dim_Of;
procedure Put_Dim_Of
(Item : Num_Dim_Integer;
Symbol : String := "")
is
begin
Ada.Text_IO.Put (Symbol);
end Put_Dim_Of;
procedure Put_Dim_Of
(To : out String;
Item : Num_Dim_Integer;
Symbol : String := "")
is
begin
To := Symbol;
end Put_Dim_Of;
end System.Dim.Integer_IO;

117
gcc/ada/s-diinio.ads
View File

@ -31,44 +31,63 @@
-- This package provides output routines for integer dimensioned types. All
-- Put routines are modelled after those in package Ada.Text_IO.Integer_IO
-- with the addition of an extra default parameter.
-- with the addition of an extra default parameter. All Put_Dim_Of routines
-- output the dimension of Item in a symbolic manner.
-- All the examples in this package are based on the MKS system of units:
-- Parameter Symbol may be used in the following manner (all the examples are
-- based on the MKS system of units as defined in package System.Dim.Mks):
-- type Mks_Type is new Integer
-- with
-- Dimension_System => ((Meter, 'm'),
-- (Kilogram, "kg"),
-- (Second, 's'),
-- (Ampere, 'A'),
-- (Kelvin, 'K'),
-- (Mole, "mol"),
-- (Candela, "cd"));
-- Parameter Symbol may be used in the following manner:
-- Dimension_System => (
-- (Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
-- (Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
-- (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
-- (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
-- (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Θ"),
-- (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
-- (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
-- Case 1. A value is supplied for Symbol
-- The string appears as a suffix of Item
-- * Put : The string appears as a suffix of Item
-- * Put_Dim_Of : The string appears alone
-- Obj : Mks_Type := 2;
-- Put (Obj, Symbols => " dimensionless");
-- Put (Obj, Symbols => "dimensionless");
-- Put_Dim_Of (Obj, Symbols => "dimensionless");
-- The corresponding output is: 2 dimensionless
-- The corresponding outputs are:
-- $2 dimensionless
-- $dimensionless
-- Case 2. No value is supplied for Symbol and Item is dimensionless
-- Item appears without a suffix
-- * Put : Item appears without a suffix
-- * Put_Dim_Of : the output is []
-- Obj : Mks_Type := 2;
-- Put (Obj);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 2
-- The corresponding outputs are:
-- $2
-- $[]
-- Case 3. No value is supplied for Symbol and Item has a dimension
-- If the type of Item is a dimensioned subtype whose symbolic name is not
-- empty, then the symbolic name appears as a suffix.
-- * Put : If the type of Item is a dimensioned subtype whose
-- symbol is not empty, then the symbol appears as a suffix.
-- Otherwise, a new string is created and appears as a
-- suffix of Item. This string results in the successive
-- concatenations between each unit symbol raised by its
-- corresponding dimension power from the dimensions of Item.
-- * Put_Dim_Of : The output is a new string resulting in the successive
-- concatenations between each dimension symbol raised by its
-- corresponding dimension power from the dimensions of Item.
-- subtype Length is Mks_Type
-- with
@ -78,25 +97,26 @@
-- Obj : Length := 2;
-- Put (Obj);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 2 m
-- Otherwise, a new string is created and appears as a suffix of Item.
-- This string results in the successive concatanations between each
-- dimension symbolic name raised by its corresponding dimension power from
-- the dimensions of Item.
-- The corresponding outputs are:
-- $2 m
-- $[L]
-- subtype Random is Mks_Type
-- with
-- Dimension => ("",
-- Meter => 3,
-- Candela => 2,
-- others => 0);
-- Meter => 3,
-- Candela => 2,
-- others => 0);
-- Obj : Random := 5;
-- Put (Obj);
-- Put_Dim_Of (Obj);
-- The corresponding output is: 5 m**3.cd**2
-- The corresponding outputs are:
-- $5 m**3.cd**2
-- $[L**3.J**2]
with Ada.Text_IO; use Ada.Text_IO;
@ -109,24 +129,39 @@ package System.Dim.Integer_IO is
Default_Base : Number_Base := 10;
procedure Put
(File : File_Type;
Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbols : String := "");
(File : File_Type;
Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbol : String := "");
procedure Put
(Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbols : String := "");
(Item : Num_Dim_Integer;
Width : Field := Default_Width;
Base : Number_Base := Default_Base;
Symbol : String := "");
procedure Put
(To : out String;
Item : Num_Dim_Integer;
Base : Number_Base := Default_Base;
Symbols : String := "");
(To : out String;
Item : Num_Dim_Integer;
Base : Number_Base := Default_Base;
Symbol : String := "");
procedure Put_Dim_Of
(File : File_Type;
Item : Num_Dim_Integer;
Symbol : String := "");
procedure Put_Dim_Of
(Item : Num_Dim_Integer;
Symbol : String := "");
procedure Put_Dim_Of
(To : out String;
Item : Num_Dim_Integer;
Symbol : String := "");
pragma Inline (Put);
pragma Inline (Put_Dim_Of);
end System.Dim.Integer_IO;

21
gcc/ada/s-dim.ads
View File

@ -42,15 +42,14 @@
-- type Mks_Type is new Long_Long_Float
-- with
-- Dimension_System => ((Meter, 'm'),
-- (Kilogram, "kg"),
-- (Second, 's'),
-- (Ampere, 'A'),
-- (Kelvin, 'K'),
-- (Mole, "mol"),
-- (Candela, "cd"));
-- 'm' is the symbolic name of dimension Meter
-- Dimension_System => (
-- (Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
-- (Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
-- (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
-- (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
-- (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Θ"),
-- (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
-- (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
-- * Dimensioned subtype
@ -59,12 +58,10 @@
-- subtype Length is Mks_Type
-- with
-- Dimension => ('m',
-- Dimension => (Symbol => 'm',
-- Meter => 1,
-- others => 0);
-- 'm' is the symbolic name of dimensioned subtype Length
package System.Dim is
pragma Pure;

75
gcc/ada/s-dimmks.ads
View File

@ -48,49 +48,50 @@ package System.Dim.Mks is
type Mks_Type is new Long_Long_Float
with
Dimension_System => ((Meter, 'm'),
(Kilogram, "kg"),
(Second, 's'),
(Ampere, 'A'),
(Kelvin, 'K'),
(Mole, "mol"),
(Candela, "cd"));
Dimension_System => (
(Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
(Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
(Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
(Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
(Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Θ"),
(Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
(Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
-- SI Base dimensioned subtype
subtype Length is Mks_Type
with
Dimension => ('m',
Meter => 1,
Dimension => (Symbol => 'm',
Meter => 1,
others => 0);
subtype Mass is Mks_Type
with
Dimension => ("kg",
Dimension => (Symbol => "kg",
Kilogram => 1,
others => 0);
subtype Time is Mks_Type
with
Dimension => ('s',
Dimension => (Symbol => 's',
Second => 1,
others => 0);
subtype Electric_Current is Mks_Type
with
Dimension => ('A',
Dimension => (Symbol => 'A',
Ampere => 1,
others => 0);
subtype Thermodynamic_Temperature is Mks_Type
with
Dimension => ('K',
Dimension => (Symbol => 'K',
Kelvin => 1,
others => 0);
subtype Amount_Of_Substance is Mks_Type
with
Dimension => ("mol",
Dimension => (Symbol => "mol",
Mole => 1,
others => 0);
subtype Luminous_Intensity is Mks_Type
with
Dimension => ("cd",
Dimension => (Symbol => "cd",
Candela => 1,
others => 0);
@ -108,56 +109,56 @@ package System.Dim.Mks is
subtype Angle is Mks_Type
with
Dimension => ("rad",
Dimension => (Symbol => "rad",
others => 0);
subtype Solid_Angle is Mks_Type
with
Dimension => ("sr",
Dimension => (Symbol => "sr",
others => 0);
subtype Frequency is Mks_Type
with
Dimension => ("Hz",
Dimension => (Symbol => "Hz",
Second => -1,
others => 0);
subtype Force is Mks_Type
with
Dimension => ('N',
Dimension => (Symbol => 'N',
Meter => 1,
Kilogram => 1,
Second => -2,
others => 0);
subtype Pressure is Mks_Type
with
Dimension => ("Pa",
Dimension => (Symbol => "Pa",
Meter => -1,
Kilogram => 1,
Second => -2,
others => 0);
subtype Energy is Mks_Type
with
Dimension => ('J',
Dimension => (Symbol => 'J',
Meter => 2,
Kilogram => 1,
Second => -2,
others => 0);
subtype Power is Mks_Type
with
Dimension => ('W',
Dimension => (Symbol => 'W',
Meter => 2,
Kilogram => 1,
Second => -3,
others => 0);
subtype Electric_Charge is Mks_Type
with
Dimension => ('C',
Dimension => (Symbol => 'C',
Second => 1,
Ampere => 1,
others => 0);
subtype Electric_Potential_Difference is Mks_Type
with
Dimension => ('V',
Dimension => (Symbol => 'V',
Meter => 2,
Kilogram => 1,
Second => -3,
@ -165,7 +166,7 @@ package System.Dim.Mks is
others => 0);
subtype Electric_Capacitance is Mks_Type
with
Dimension => ('F',
Dimension => (Symbol => 'F',
Meter => -2,
Kilogram => -1,
Second => 4,
@ -173,7 +174,7 @@ package System.Dim.Mks is
others => 0);
subtype Electric_Resistance is Mks_Type
with
Dimension => ("Ω",
Dimension => (Symbol => "Ω",
Meter => 2,
Kilogram => 1,
Second => -3,
@ -181,7 +182,7 @@ package System.Dim.Mks is
others => 0);
subtype Electric_Conductance is Mks_Type
with
Dimension => ('S',
Dimension => (Symbol => 'S',
Meter => -2,
Kilogram => -1,
Second => 3,
@ -189,7 +190,7 @@ package System.Dim.Mks is
others => 0);
subtype Magnetic_Flux is Mks_Type
with
Dimension => ("Wb",
Dimension => (Symbol => "Wb",
Meter => 2,
Kilogram => 1,
Second => -2,
@ -197,14 +198,14 @@ package System.Dim.Mks is
others => 0);
subtype Magnetic_Flux_Density is Mks_Type
with
Dimension => ('T',
Dimension => (Symbol => 'T',
Kilogram => 1,
Second => -2,
Ampere => -1,
others => 0);
subtype Inductance is Mks_Type
with
Dimension => ('H',
Dimension => (Symbol => 'H',
Meter => 2,
Kilogram => 1,
Second => -2,
@ -212,40 +213,40 @@ package System.Dim.Mks is
others => 0);
subtype Celsius_Temperature is Mks_Type
with
Dimension => ("°C",
Dimension => (Symbol => "°C",
Kelvin => 1,
others => 0);
subtype Luminous_Flux is Mks_Type
with
Dimension => ("lm",
Dimension => (Symbol => "lm",
Candela => 1,
others => 0);
subtype Illuminance is Mks_Type
with
Dimension => ("lx",
Dimension => (Symbol => "lx",
Meter => -2,
Candela => 1,
others => 0);
subtype Radioactivity is Mks_Type
with
Dimension => ("Bq",
Dimension => (Symbol => "Bq",
Second => -1,
others => 0);
subtype Absorbed_Dose is Mks_Type
with
Dimension => ("Gy",
Dimension => (Symbol => "Gy",
Meter => 2,
Second => -2,
others => 0);
subtype Equivalent_Dose is Mks_Type
with
Dimension => ("Sv",
Dimension => (Symbol => "Sv",
Meter => 2,
Second => -2,
others => 0);
subtype Catalytic_Activity is Mks_Type
with
Dimension => ("kat",
Dimension => (Symbol => "kat",
Second => -1,
Mole => 1,
others => 0);

17
gcc/ada/sem_case.adb
View File

@ -159,6 +159,15 @@ package body Sem_Case is
Msg_Sloc : constant Source_Ptr := Sloc (Case_Node);
begin
-- AI05-0188 : within an instance the non-others choices do not
-- have to belong to the actual subtype.
if Ada_Version >= Ada_2012
and then In_Instance
then
return;
end if;
-- In some situations, we call this with a null range, and
-- obviously we don't want to complain in this case!
@ -718,6 +727,14 @@ package body Sem_Case is
Raises_CE := True;
return;
-- AI05-0188 : within an instance the non-others choices do not
-- have to belong to the actual subtype.
elsif Ada_Version >= Ada_2012
and then In_Instance
then
return;
-- Otherwise we have an OK static choice
else

5
gcc/ada/sem_ch12.adb
View File

@ -10811,6 +10811,11 @@ package body Sem_Ch12 is
pragma Assert (Present (Ancestor));
-- the ancestor itself may be a previous formal that
-- has been instantiated.
Ancestor := Get_Instance_Of (Ancestor);
else
Ancestor :=
Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));

30
gcc/ada/sem_ch13.adb
View File

@ -6136,7 +6136,11 @@ package body Sem_Ch13 is
if A_Id = Aspect_Synchronization then
return;
-- Case of stream attributes, just have to compare entities
-- Case of stream attributes, just have to compare entities. However,
-- the expression is just a name (possibly overloaded), and there may
-- be stream operations declared for unrelated types, so we just need
-- to verify that one of these interpretations is the one available at
-- at the freeze point.
elsif A_Id = Aspect_Input or else
A_Id = Aspect_Output or else
@ -6144,7 +6148,29 @@ package body Sem_Ch13 is
A_Id = Aspect_Write
then
Analyze (End_Decl_Expr);
Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
if not Is_Overloaded (End_Decl_Expr) then
Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
else
Err := True;
declare
Index : Interp_Index;
It : Interp;
begin
Get_First_Interp (End_Decl_Expr, Index, It);
while Present (It.Typ) loop
if It.Nam = Entity (Freeze_Expr) then
Err := False;
exit;
end if;
Get_Next_Interp (Index, It);
end loop;
end;
end if;
elsif A_Id = Aspect_Variable_Indexing or else
A_Id = Aspect_Constant_Indexing or else

941
gcc/ada/sem_dim.adb
View File

File diff suppressed because it is too large Load Diff

2
gcc/ada/sem_dim.ads
View File

@ -137,7 +137,7 @@ package Sem_Dim is
-- restricted to Integer exponent. This routine deals only with rational
-- exponent which is not an integer if Btyp is a dimensioned type.
procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id);
procedure Expand_Put_Call_With_Symbol (N : Node_Id);
-- Determine whether N denotes a subprogram call to one of the routines
-- defined in System.Dim.Float_IO or System.Dim.Integer_IO and add an
-- extra actual to the call to represent the symbolic representation of

18
gcc/ada/sem_elim.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2012, 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- --
@ -724,6 +724,14 @@ package body Sem_Elim is
Enclosing_Subp : Entity_Id;
begin
-- No check needed within a default expression for a formal, since this
-- is not really a use, and the expression (a call or attribute) may
-- never be used if the enclosing subprogram is itself eliminated.
if In_Spec_Expression then
return;
end if;
if Is_Eliminated (Ultimate_Subp)
and then not Inside_A_Generic
and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
@ -823,10 +831,10 @@ package body Sem_Elim is
Arg_Uname : Node_Id;
function OK_Selected_Component (N : Node_Id) return Boolean;
-- Test if N is a selected component with all identifiers, or a
-- selected component whose selector is an operator symbol. As a
-- side effect if result is True, sets Num_Names to the number
-- of names present (identifiers and operator if any).
-- Test if N is a selected component with all identifiers, or a selected
-- component whose selector is an operator symbol. As a side effect if
-- result is True, sets Num_Names to the number of names present
-- (identifiers, and operator if any).
---------------------------
-- OK_Selected_Component --

11
gcc/ada/sem_res.adb
View File

@ -5839,14 +5839,11 @@ package body Sem_Res is
Check_Restriction (No_Relative_Delay, N);
end if;
-- Issue an error for a call to an eliminated subprogram. We skip this
-- in a spec expression, e.g. a call in a default parameter value, since
-- we are not really doing a call at this time. That's important because
-- the spec expression may itself belong to an eliminated subprogram.
-- Issue an error for a call to an eliminated subprogram.
-- The routine will not perform the check if the call appears within
-- a default expression.
if not In_Spec_Expression then
Check_For_Eliminated_Subprogram (Subp, Nam);
end if;
Check_For_Eliminated_Subprogram (Subp, Nam);
-- In formal mode, the primitive operations of a tagged type or type
-- extension do not include functions that return the tagged type.

9
gcc/ada/snames.ads-tmpl
View File

@ -225,9 +225,12 @@ package Snames is
-- Names used by the analyzer and expander for aspect Dimension and
-- Dimension_System to deal with Sqrt and IO routines.
Name_Item : constant Name_Id := N + $; -- Ada 12
Name_Sqrt : constant Name_Id := N + $; -- Ada 12
Name_Symbols : constant Name_Id := N + $; -- Ada 12
Name_Dim_Symbol : constant Name_Id := N + $; -- Ada 12
Name_Item : constant Name_Id := N + $; -- Ada 12
Name_Put_Dim_Of : constant Name_Id := N + $; -- Ada 12
Name_Sqrt : constant Name_Id := N + $; -- Ada 12
Name_Symbol : constant Name_Id := N + $; -- Ada 12
Name_Unit_Symbol : constant Name_Id := N + $; -- Ada 12
-- Some miscellaneous names used for error detection/recovery