From 5dcc05e6bcbe1976ddfa17c82eb5b5e0f8654752 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 15 Nov 2005 14:57:25 +0100 Subject: [PATCH] sem_disp.adb: Change name Is_Package to Is_Package_Or_Generic_Package 2005-11-14 Javier Miranda Robert Dewar Hristian Kirtchev * sem_disp.adb: Change name Is_Package to Is_Package_Or_Generic_Package (Check_Dispatching_Operation): Protect the frontend againts previously detected errors. * Makefile.rtl: Add new instantiations of system.fat_gen * s-fatflt.ads, s-fatlfl.ads, s-fatllf.ads, s-fatsfl.ads: Change name of instantiated package for better consistency with newly added system.fat_gen instantiations. * s-filofl.ads, s-fishfl.ads, s-fvadfl.ads, s-fvaffl.ads, s-fvagfl.ads: New files. From-SVN: r106971 --- gcc/ada/Makefile.rtl | 5 ++++ gcc/ada/s-fatflt.ads | 2 +- gcc/ada/s-fatlfl.ads | 2 +- gcc/ada/s-fatllf.ads | 2 +- gcc/ada/s-fatsfl.ads | 2 +- gcc/ada/s-filofl.ads | 54 ++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-fishfl.ads | 54 ++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-fvadfl.ads | 56 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-fvaffl.ads | 56 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-fvagfl.ads | 56 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_disp.adb | 17 ++++++++------ 11 files changed, 295 insertions(+), 11 deletions(-) create mode 100644 gcc/ada/s-filofl.ads create mode 100644 gcc/ada/s-fishfl.ads create mode 100644 gcc/ada/s-fvadfl.ads create mode 100644 gcc/ada/s-fvaffl.ads create mode 100644 gcc/ada/s-fvagfl.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index aa92689fb11..d1d34ee958f 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -391,9 +391,14 @@ GNATRTL_NONTASKING_OBJS= \ s-fatsfl$(objext) \ s-ficobl$(objext) \ s-fileio$(objext) \ + s-filofl$(objext) \ + s-fishfl$(objext) \ s-finimp$(objext) \ s-finroo$(objext) \ s-fore$(objext) \ + s-fvadfl$(objext) \ + s-fvaffl$(objext) \ + s-fvagfl$(objext) \ s-geveop$(objext) \ s-htable$(objext) \ s-imgbiu$(objext) \ diff --git a/gcc/ada/s-fatflt.ads b/gcc/ada/s-fatflt.ads index 92ad4499923..2ba596bc4a5 100644 --- a/gcc/ada/s-fatflt.ads +++ b/gcc/ada/s-fatflt.ads @@ -44,6 +44,6 @@ package System.Fat_Flt is -- (i.e. the individual floating-point attribute routines) are accessed -- by name using selected notation. - package Fat_Float is new System.Fat_Gen (Float); + package Attr_Float is new System.Fat_Gen (Float); end System.Fat_Flt; diff --git a/gcc/ada/s-fatlfl.ads b/gcc/ada/s-fatlfl.ads index bff94090190..844f1b4739a 100644 --- a/gcc/ada/s-fatlfl.ads +++ b/gcc/ada/s-fatlfl.ads @@ -44,6 +44,6 @@ package System.Fat_LFlt is -- (i.e. the individual floating-point attribute routines) are accessed -- by name using selected notation. - package Fat_Long_Float is new System.Fat_Gen (Long_Float); + package Attr_Long_Float is new System.Fat_Gen (Long_Float); end System.Fat_LFlt; diff --git a/gcc/ada/s-fatllf.ads b/gcc/ada/s-fatllf.ads index bb8abf4e015..f2d554c4dab 100644 --- a/gcc/ada/s-fatllf.ads +++ b/gcc/ada/s-fatllf.ads @@ -44,6 +44,6 @@ package System.Fat_LLF is -- (i.e. the individual floating-point attribute routines) are accessed -- by name using selected notation. - package Fat_Long_Long_Float is new System.Fat_Gen (Long_Long_Float); + package Attr_Long_Long_Float is new System.Fat_Gen (Long_Long_Float); end System.Fat_LLF; diff --git a/gcc/ada/s-fatsfl.ads b/gcc/ada/s-fatsfl.ads index 1d1f3509652..129efea64a2 100644 --- a/gcc/ada/s-fatsfl.ads +++ b/gcc/ada/s-fatsfl.ads @@ -44,6 +44,6 @@ package System.Fat_SFlt is -- (i.e. the individual floating-point attribute routines) are accessed -- by name using selected notation. - package Fat_Short_Float is new System.Fat_Gen (Short_Float); + package Attr_Short_Float is new System.Fat_Gen (Short_Float); end System.Fat_SFlt; diff --git a/gcc/ada/s-filofl.ads b/gcc/ada/s-filofl.ads new file mode 100644 index 00000000000..dded3cf5a94 --- /dev/null +++ b/gcc/ada/s-filofl.ads @@ -0,0 +1,54 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F A T _ I E E E _ L O N G _ F L O A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains an instantiation of the floating-point attribute +-- runtime routines for IEEE long float. This is used on VMS targest where +-- we can't just use Long_Float, since this may have been mapped to Vax_Float +-- using a Float_Representation configuration pragma. + +with System.Fat_Gen; + +package System.Fat_IEEE_Long_Float is + pragma Pure; + + type Fat_IEEE_Long is digits 15; + pragma Float_Representation (IEEE_Float, Fat_IEEE_Long); + + -- Note the only entity from this package that is acccessed by Rtsfind + -- is the name of the package instantiation. Entities within this package + -- (i.e. the individual floating-point attribute routines) are accessed + -- by name using selected notation. + + package Attr_IEEE_Long is new System.Fat_Gen (Fat_IEEE_Long); + +end System.Fat_IEEE_Long_Float; diff --git a/gcc/ada/s-fishfl.ads b/gcc/ada/s-fishfl.ads new file mode 100644 index 00000000000..7308618f1ad --- /dev/null +++ b/gcc/ada/s-fishfl.ads @@ -0,0 +1,54 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F A T _ I E E E _ S H O R T _ F L O A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains an instantiation of the floating-point attribute +-- runtime routines for IEEE short float. This is used on VMS targest where +-- we can't just use Float, since this may have been mapped to Vax_Float +-- using a Float_Representation configuration pragma. + +with System.Fat_Gen; + +package System.Fat_IEEE_Short_Float is + pragma Pure; + + type Fat_IEEE_Short is digits 6; + pragma Float_Representation (IEEE_Float, Fat_IEEE_Short); + + -- Note the only entity from this package that is acccessed by Rtsfind + -- is the name of the package instantiation. Entities within this package + -- (i.e. the individual floating-point attribute routines) are accessed + -- by name using selected notation. + + package Attr_IEEE_Short is new System.Fat_Gen (Fat_IEEE_Short); + +end System.Fat_IEEE_Short_Float; diff --git a/gcc/ada/s-fvadfl.ads b/gcc/ada/s-fvadfl.ads new file mode 100644 index 00000000000..05a367ca42f --- /dev/null +++ b/gcc/ada/s-fvadfl.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F A T _ V A X _ D _ F L O A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains an instantiation of the floating-point attribute +-- runtime routines for VAX D-float for use on VMS targets. + +with System.Fat_Gen; + +package System.Fat_VAX_D_Float is + pragma Pure; + + pragma Warnings (Off); + -- This unit is normally used only for VMS, but we compile it for other + -- targest for the convenience of testing vms code using -gnatdm. + + type Fat_VAX_D is digits 9; + pragma Float_Representation (VAX_Float, Fat_VAX_D); + + -- Note the only entity from this package that is acccessed by Rtsfind + -- is the name of the package instantiation. Entities within this package + -- (i.e. the individual floating-point attribute routines) are accessed + -- by name using selected notation. + + package Attr_VAX_D_Float is new System.Fat_Gen (Fat_VAX_D); + +end System.Fat_VAX_D_Float; diff --git a/gcc/ada/s-fvaffl.ads b/gcc/ada/s-fvaffl.ads new file mode 100644 index 00000000000..0c769bfd9d1 --- /dev/null +++ b/gcc/ada/s-fvaffl.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F A T _ V A X _ F _ F L O A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains an instantiation of the floating-point attribute +-- runtime routines for VAX F-float for use on VMS targets. + +with System.Fat_Gen; + +package System.Fat_VAX_F_Float is + pragma Pure; + + pragma Warnings (Off); + -- This unit is normally used only for VMS, but we compile it for other + -- targest for the convenience of testing vms code using -gnatdm. + + type Fat_VAX_F is digits 6; + pragma Float_Representation (VAX_Float, Fat_VAX_F); + + -- Note the only entity from this package that is acccessed by Rtsfind + -- is the name of the package instantiation. Entities within this package + -- (i.e. the individual floating-point attribute routines) are accessed + -- by name using selected notation. + + package Attr_VAX_F_Float is new System.Fat_Gen (Fat_VAX_F); + +end System.Fat_VAX_F_Float; diff --git a/gcc/ada/s-fvagfl.ads b/gcc/ada/s-fvagfl.ads new file mode 100644 index 00000000000..50a06b9e9e1 --- /dev/null +++ b/gcc/ada/s-fvagfl.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F A T _ V A X _ G _ F L O A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains an instantiation of the floating-point attribute +-- runtime routines for VAX F-float for use on VMS targets. + +with System.Fat_Gen; + +package System.Fat_VAX_G_Float is + pragma Pure; + + pragma Warnings (Off); + -- This unit is normally used only for VMS, but we compile it for other + -- targest for the convenience of testing vms code using -gnatdm. + + type Fat_VAX_G is digits 15; + pragma Float_Representation (VAX_Float, Fat_VAX_G); + + -- Note the only entity from this package that is acccessed by Rtsfind + -- is the name of the package instantiation. Entities within this package + -- (i.e. the individual floating-point attribute routines) are accessed + -- by name using selected notation. + + package Attr_VAX_G_Float is new System.Fat_Gen (Fat_VAX_G); + +end System.Fat_VAX_G_Float; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 96836a75915..a187b153848 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -550,10 +550,13 @@ package body Sem_Disp is if Ada_Version = Ada_05 and then Present (Tagged_Type) and then Is_Concurrent_Type (Tagged_Type) - and then not Is_Empty_Elmt_List - (Abstract_Interfaces - (Corresponding_Record_Type (Tagged_Type))) then + -- Protect the frontend against previously detected errors + + if not Present (Corresponding_Record_Type (Tagged_Type)) then + return; + end if; + Tagged_Type := Corresponding_Record_Type (Tagged_Type); end if; @@ -589,8 +592,8 @@ package body Sem_Disp is -- where it can be a dispatching op is when it overrides an operation -- before the freezing point of the type. - elsif ((not Is_Package (Scope (Subp))) - or else In_Package_Body (Scope (Subp))) + elsif ((not Is_Package_Or_Generic_Package (Scope (Subp))) + or else In_Package_Body (Scope (Subp))) and then not Has_Dispatching_Parent then if not Comes_From_Source (Subp) @@ -1261,7 +1264,7 @@ package body Sem_Disp is Replace_Elmt (Op_Elmt, New_Op); end if; - if (not Is_Package (Current_Scope)) + if (not Is_Package_Or_Generic_Package (Current_Scope)) or else not In_Private_Part (Current_Scope) then -- Not a private primitive